Hilfe mit Makro - Fünf Zielwertsuche automatisch ausführen

[JoeHardi]

Servus in die Runde,

schon seit einiger Zeit möchte ich in einem Calc Dokument ein Makro einbauen, dass mir gleich beim Öffnen des Dokuments fünf Zielwertsuche auf der Seite "VERMÖGEN" automatisch ausführt. Ich bekomme es leider ums verrecken nicht hin.

Ich weiß, dass es ein großes Thema ist, aber vielleicht hat jemand Zeit und Lust mir dabei zu helfen?

Die fünf Zielwertsuche wären:

1.
Formelzelle: $D$76
Zielwert: 0
Variable Zelle: $D$74

2.
Formelzelle: $F$76
Zielwert: 0
Variable Zelle: $F$74

3.
Formelzelle: $H$76
Zielwert: 0
Variable Zelle: $H$74

4.
Formelzelle: $J$76
Zielwert: 0
Variable Zelle: $J$74

5.
Formelzelle: $L$76
Zielwert: 0
Variable Zelle: $L$74

Das, was ich mir bis jetzt zusammengereimt habe ich:

Code: Alles auswählen

Option Explicit

Sub AutoRun_GoalSeeks
    Dim oDoc As Object
    Dim oSheets As Object
    Dim oSheet As Object

    oDoc = ThisComponent
    If oDoc Is Nothing Then
        MsgBox "Dokument nicht gefunden.", 16, "Makrofehler": Exit Sub
    End If

    ' Prüfen, ob es ein Spreadsheet-Dokument ist
    If Not oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument") Then
        MsgBox "Dieses Makro muss in einer Calc-Datei ausgeführt werden.", 16, "Makrofehler": Exit Sub
    End If

    oSheets = oDoc.getSheets()  ' zuverlässiger Zugriff
    If Not oSheets.hasByName("VERMÖGEN") Then
        MsgBox "Blatt 'VERMÖGEN' nicht gefunden.", 16, "Makrofehler": Exit Sub
    End If
    oSheet = oSheets.getByName("VERMÖGEN")

    ' GoalSeeks
    DoGoalSeek oDoc, oSheet, "D76", 0, "D74"
    DoGoalSeek oDoc, oSheet, "F76", 0, "F74"
    DoGoalSeek oDoc, oSheet, "H76", 0, "H74"
    DoGoalSeek oDoc, oSheet, "J76", 0, "J74"
    DoGoalSeek oDoc, oSheet, "L76", 0, "L74"
End Sub

Sub DoGoalSeek(oDoc As Object, oSheet As Object, sTargetRef As String, dGoal As Double, sVariableRef As String)
    Dim oTargetCell As Object, oVariableCell As Object
    Dim oArgs(2) As New com.sun.star.beans.PropertyValue
    Dim bSuccess As Boolean

    On Error GoTo LocalErr

    oTargetCell = oSheet.getCellRangeByName(sTargetRef)
    oVariableCell = oSheet.getCellRangeByName(sVariableRef)
    If oTargetCell Is Nothing Or oVariableCell Is Nothing Then
        MsgBox "Zellen nicht gefunden: " & sTargetRef & " oder " & sVariableRef, 16, "GoalSeek-Fehler": Exit Sub
    End If

    oArgs(0).Name = "TargetCell": oArgs(0).Value = oTargetCell
    oArgs(1).Name = "GoalValue":  oArgs(1).Value = dGoal
    oArgs(2).Name = "ChangingCell": oArgs(2).Value = oVariableCell

    oDoc.calculateAll

    bSuccess = False
    On Error Resume Next
    Err.Clear
    oDoc.GoalSeek(oArgs())
    If Err.Number = 0 Then bSuccess = True
    Err.Clear

    If Not bSuccess Then
        oDoc.getSheets().getByIndex(0).GoalSeek(oArgs())
        If Err.Number = 0 Then bSuccess = True
        Err.Clear
    End If

    If Not bSuccess Then
        oSheet.GoalSeek(oArgs())
        If Err.Number = 0 Then bSuccess = True
        Err.Clear
    End If
    On Error GoTo 0

    If Not bSuccess Then MsgBox "GoalSeek für " & sTargetRef & " → " & sVariableRef & " fehlgeschlagen.", 16, "GoalSeek-Fehler"
    Exit Sub

LocalErr:
    Dim sMsg As String
    sMsg = "Fehler bei GoalSeek für " & sTargetRef & " → " & sVariableRef & Chr(10) & "Fehlernummer: " & Err.Number
    If Len(Err.Description) > 0 Then sMsg = sMsg & Chr(10) & "Beschreibung: " & Err.Description
    MsgBox sMsg, 16, "Makrofehler"
End Sub

Ich bin um jede Hilfe dankbar!