Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1340to1344
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Code Problem - Zielwertsuche mit VBA

VBA Code Problem - Zielwertsuche mit VBA
26.11.2013 14:07:49
Ralf
Hallo Forum,
ich habe in einer Arbeitsmappe eine Zielwertsuche mit VBA eingebaut.
Folgenden Code habe dafür mit Makrorekorder aufgezeichnet:
Sub Zielwertsuche_Stückzahl()
'Bildschirmaktualisierung aus
Application.ScreenUpdating = False
Sheets("Umlage").Select
Call Tabellenblatt_entsperren
Range("B29").Select
ActiveCell.FormulaR1C1 = "100000"
Dim Mldg1 As String, Titel1 As String, Wert1
Dim Mldg2 As String, Titel2 As String, Wert2
Dim Mldg3 As String, Titel3 As String, Wert3
Select Case Worksheets("Sprachauswahl").Range("C10")
Case 1: Mldg1 = "Bitte die Umlage eintragen. Die zugehörige Umlagestückzahl wird errechnet." _
Case 2: Mldg1 = ""
Case Else
End Select
Select Case Worksheets("Sprachauswahl").Range("C10")
Case 1: Mldg2 = "Bitte die Anzahl der Umlagejahre angeben."
Case 2: Mldg2 = ""
Case Else
End Select
Select Case Worksheets("Sprachauswahl").Range("C10")
Case 1: Mldg3 = "Bitte den Instandhaltungssatz in Prozent angeben."
Case 2: Mldg3 = ""
Case Else
End Select
Select Case Worksheets("Sprachauswahl").Range("C10")
Case 1: Titel1 = "Zielwert für Umlage"
Case 2: Titel1 = ""
Case Else
End Select
Select Case Worksheets("Sprachauswahl").Range("C10")
Case 1: Titel2 = "Umlagejahre"
Case 2: Titel2 = ""
Case Else
End Select
Select Case Worksheets("Sprachauswahl").Range("C10")
Case 1: Titel3 = "Instandhaltung"
Case 2: Titel3 = ""
Case Else
End Select
Wert1 = InputBox(Mldg1, Titel1)
If Wert1 = "" Or Not IsNumeric(Wert1) Then GoTo Beenden
Wert2 = InputBox(Mldg2, Titel2)
If Wert2 = "" Or Not IsNumeric(Wert1) Then GoTo Beenden
Wert3 = InputBox(Mldg3, Titel3)
If Wert3 = "" Or Not IsNumeric(Wert1) Then GoTo Beenden
'für Excel 2007
If AddIns("Solver").Installed = False Then
AddIns("Solver").Installed = True
End If
'Set Solv = AddIns("Solver Add-In")
'If Solv.Installed = False Then
'AddIns("Solver Add-in").Installed = True
'End If
'für Excel 2010
'AddIns("Solver").Installed = True
With Application
.Iteration = True
.MaxIterations = 32767
.MaxChange = 0.000001
End With
Range("B15") = Wert2
Range("B18") = Wert3 / 100
Range("E34").GoalSeek Goal:=CDbl(Wert1), ChangingCell:=Range("B29")
'Ergebniszelle => Range("E34").goalseek
'Zielwert => Goal:=Wert1
'Variable Zelle => ChangingCell:=Range("B29")
Beenden:
Range("B21:B28").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Locked = True
Selection.FormulaHidden = False
Range("B29").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Selection.Locked = False
Selection.FormulaHidden = False
Range("C29").Select
'=WENN(B29=F29;"";"Einzelvolumen unberücksichtigt!")
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=RC[3],"""",""Einzelvolumen unberücksichtigt!"")"
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.InsertIndent 1
Call Tabellenblatt_sperren
Range("A1").Select
End Sub

Nun bekomme ich in der Zeile
.ThemeColor = xlThemeColorDark1
einen Laufzeitfehler:
Laufzeitfehler '1004':
Anwendungs- oder objektdefinierter Fehler
Fortfahren (ausgegraut) Beenden Debuggen Hilfe
Kann mir jemand helfen, und mitteilen woran dies liegen könnte?
Vielen Dank im Voraus für eine Rückmeldung.
Viele Grüße
Ralf

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Code Problem - Zielwertsuche mit VBA
28.11.2013 20:23:31
Mike
Vielleicht kannst Du uns eine Kopie der Datei einstellen. So lässt sich das besser nachvollziehen.
Ich würde versuchen die Zeile, wo der Fehler kommt mal auskommentieren. Ist eh nur eine Formatierung. Sollte dann in der nächsten Zeile der Fehler immer noch kommen, tippe ich auf den Schreibschutz. Auch wenn ich sah, dass Du mit Call den Tabellenblattschutz ausschaltest bzw. versuchst.^^ Überprüfe das erstmal.
Gruß Mike

AW: VBA Code Problem - Zielwertsuche mit VBA
29.11.2013 06:23:49
Ralf
Hallo Mike,
ohne den Grund jetzt genauer zu kennen habe ich vor den Formatierungen nochmal ein Call Tabellenblatt_entsperren
gesetzt.
Jetzt funktioniert's.
Dein Tipp war genau richtig.
Vielen Dank.
Viele Grüße
Ralf

Anzeige
Danke für Feedback - oT
29.11.2013 17:38:16
Mike
danke fürs Feedback

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige