Thema Datum  Von Nutzer Rating
Antwort
Rot Die Methode 'Calculation' für das Object '_Application" ist fehlgeschlagen
04.09.2023 10:43:06 ws-53
Solved
04.09.2023 10:45:11 Gast57489
NotSolved
04.09.2023 11:11:57 Mase
NotSolved
04.09.2023 11:23:39 Volti
NotSolved
04.09.2023 11:20:01 Volti
NotSolved
04.09.2023 12:14:31 Gast84780
NotSolved
04.09.2023 12:17:46 ws-53
NotSolved
04.09.2023 12:44:25 ws-53
NotSolved
04.09.2023 13:30:24 Gast51918
NotSolved
04.09.2023 13:41:25 Mase
NotSolved
04.09.2023 13:32:54 ws-53
NotSolved
04.09.2023 13:39:39 Mase
NotSolved
04.09.2023 13:55:18 ws-53
NotSolved

Ansicht des Beitrags:
Von:
ws-53
Datum:
04.09.2023 10:43:06
Views:
1153
Rating: Antwort:
 Nein
Thema:
Die Methode 'Calculation' für das Object '_Application" ist fehlgeschlagen

Hallo,

ich teste gerade erstmals die Ausführung eines Excel-Makros durch Aufruf einer VBS-Datei und lauf dabei auf dem im Thema beschriebenen Fehler.

Hier die VBS-Datei:

' Referenz: https://www.youtube.com/watch?v=mNvFCE1pjAM
' Excel starten

Set xlsApp = CreateObject("Excel.Application")

'Sichtbarkeit
'xlsApp.Visible = False
xlsApp.Application.Visible = False

'Workbook öffnen
Set xlsWb = xlsApp.Workbooks.Open("C:\Users\Wilfried\Documents\Excel\Power Queries remote aktualisieren - Test_1.xlsm")

'Makro ausführen
xlsApp.Run("Aufgabenplanung")

xlsApp.DisplayAlerts = False
xlsApp.ActiveWorkbook.Close True

'Workbook close
xlsApp.Quit

Und hier der MakroCode:

Option Explicit
Sub Aufgabenplanung()
    
    Call Remote_Refresh
'    MsgBox "Remote_refresh: finished"

'   Bei einem Aufruf durch eine VBS-Datei erzeugen die Nachfolgenden Schritte Fehlermeldungen.
'   Wobei das sichern auch aus dem VBS-Script durchgeführt werden kann
    
'    ActiveWorkbook.Connections("Abfrage - tbl_Log_Queries").Refresh
'    MsgBox "Abfrage - tbl_Log_Queries: finished"
    
'    ActiveWorkbook.Connections("Abfrage - tbl_Log_Workbooks").Refresh
'    MsgBox "Abfrage - tbl_Log_Workbooks: finished"
    
'    ActiveWorkbook.Save
'    MsgBox "ActiveWorkbook.Save: finished"

End Sub

Sub Remote_Refresh()

Dim wb As Workbook, _
    WB_name As String, _
    wb_remote As String, _
    no_close As String, _
    curr_WB_name As String, _
    excel_File As Workbook, _
    wk_path_wb As String, _
    wk_repeats As Integer, _
    wk_count As Integer, wk_refreshes As Integer, _
    idx As Integer, _
    x As Integer, _
    Last_Dir As String, Last_WB As String, Curr_Dir As String, Curr_WB As String, _
    wb_opened As String, _
    wk_now
    
Dim PQ_start As Double, _
    PQ_Ende  As Double, _
    PQ_Dauer As Double, _
    wk_range As String, _
    PQ_name As String, PQ_name_pur As String, _
    lobj_log As ListObject, _
    log_rows As Integer
        
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    wk_count = Sheets("T1").ListObjects("tbl_remote_refresh").ListRows.Count
    log_rows = Sheets("Log").ListObjects("tbl_Log").ListRows.Count

    wk_now = DateTime.Now
    
    WB_name = ActiveWorkbook.Name

    For idx = 1 To wk_count
        With Sheets("T1").ListObjects("tbl_remote_refresh")
             If idx = 1 Then
                .ListColumns("Start").DataBodyRange.ClearContents
                .ListColumns("Ende").DataBodyRange.ClearContents
                .ListColumns("Dauer").DataBodyRange.ClearContents
             End If
        
             If .ListColumns("Directory").DataBodyRange(idx).Value <> "" Then
                 Curr_Dir = .ListColumns("Directory").DataBodyRange(idx).Value
             End If
             If .ListColumns("Workbook").DataBodyRange(idx).Value <> "" Then
                 Curr_WB = .ListColumns("Workbook").DataBodyRange(idx).Value
             End If
             If Curr_Dir = "" Then
                Curr_Dir = Last_Dir
             End If
             If Curr_WB = "" Then
                Curr_WB = Last_WB
             End If
             
             If (Curr_Dir <> Last_Dir Or _
                Curr_WB <> Last_WB) And _
                wb_opened = "x" Then
                wb_opened = ""
                Last_Dir = Curr_Dir
                Last_WB = Curr_WB
                If wk_refreshes > 0 Then
                   wk_refreshes = 0
                   If no_close <> "x" Then
                      wb.Windows(1).Visible = True
                      wb.Close SaveChanges:=True
                   Else
                      wb.Save
                   End If
                Else
                   If no_close <> "x" Then
                      wb.Close SaveChanges:=False
                   End If
                End If
             End If
              
             Last_Dir = Curr_Dir
             Last_WB = Curr_WB
              
             If Curr_Dir <> "" And Curr_WB <> "" And wb_opened = "" Then
                For Each excel_File In Workbooks
                    If excel_File.Name = Curr_WB Then
                       no_close = "x"
                       Exit For
                    End If
                Next
                
                wb_remote = Curr_Dir & Curr_WB
                 
                On Error GoTo not_opened
                Application.DisplayAlerts = False
                Set wb = GetObject(wb_remote)     'Auch notwendig, wenn bereits offen
                Application.DisplayAlerts = True
                wb_opened = "x"
                On Error GoTo 0
             End If

'            Nur wenn ein Workbook geöffnet wurde, wird Refresh = "Ja" berücksichtigt
'            In den Abfrageeinstellungen der relevanten Abfragen muss die Option
'            "Aktualisierung im Hintergrund zulassen" deaktiviert sein.
                
             If .ListColumns("Refresh").DataBodyRange(idx).Value = "Ja" And wb_opened = "x" Then
                wk_refreshes = wk_refreshes + 1
                PQ_name = "Abfrage - " & .ListColumns("Query").DataBodyRange(idx).Value
                PQ_name_pur = .ListColumns("Query").DataBodyRange(idx).Value
                PQ_start = Timer
                wb.Connections(PQ_name).Refresh
                PQ_Ende = Timer
                PQ_Dauer = PQ_Ende - PQ_start
                .ListColumns("Start").DataBodyRange(idx).Value = PQ_start / 86400
                .ListColumns("Ende").DataBodyRange(idx).Value = PQ_Ende / 86400
                .ListColumns("Dauer").DataBodyRange(idx).Value = PQ_Dauer
                 
                .ListColumns("Anz. Dauer").DataBodyRange(idx).Value = .ListColumns("Anz. Dauer").DataBodyRange(idx) + 1
                .ListColumns("Dauer kum.").DataBodyRange(idx).Value = .ListColumns("Dauer kum.").DataBodyRange(idx) + PQ_Dauer

                If .ListColumns("Dauer min.").DataBodyRange(idx).Value = "" Or _
                   .ListColumns("Dauer min.").DataBodyRange(idx).Value > PQ_Dauer Then
                   .ListColumns("Dauer min.").DataBodyRange(idx).Value = PQ_Dauer
                End If

                If .ListColumns("Dauer max.").DataBodyRange(idx).Value = "" Or _
                   .ListColumns("Dauer max.").DataBodyRange(idx).Value < PQ_Dauer Then
                   .ListColumns("Dauer max.").DataBodyRange(idx).Value = PQ_Dauer
                End If
              End If
         
              If .ListColumns("Refresh").DataBodyRange(idx).Value = "Ja" And wb_opened = "x" Then
                   With Sheets("Log").ListObjects("tbl_Log")
                      .ListRows.Add
                      log_rows = log_rows + 1
                      .ListColumns("Timestamp").DataBodyRange(log_rows).Value = wk_now
                      .ListColumns("Workbook").DataBodyRange(log_rows).Value = Curr_WB
                      .ListColumns("Query").DataBodyRange(log_rows).Value = PQ_name_pur
                      .ListColumns("Start").DataBodyRange(log_rows).Value = PQ_start / 86400
                      .ListColumns("End").DataBodyRange(log_rows).Value = PQ_Ende / 86400
                      .ListColumns("Duration").DataBodyRange(log_rows).Value = PQ_Dauer
                   End With
               End If
        End With

not_opened:
        Application.DisplayAlerts = True
    Next
            
    If wk_refreshes > 0 Then
       If no_close <> "x" Then
          wb.Windows(1).Visible = True
          wb.Close SaveChanges:=True
       Else
'         Werden die Änderungen in der geöffneten Mappe gezeigt ???
          wb.Save
       End If
    Else
       If no_close <> "x" Then
          wb.Close SaveChanges:=False
       End If
    End If
            
'    On Error Resume Next
'   Bei einem Aufruf durch eine VBS-Datei erzeugt der nachfolgende Schritt eine Fehlermeldung.
    Application.Calculation = xlCalculationAutomatic
'    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

 

Die Fehlermeldung wird durch die rot markierte Zeile verursacht. Jedoch nicht, wenn das Makro direkt aus der Mappe aufgerufen wird. 

Vielleicht hat ja jemand eine Erklärung für dieses Verhalten.

Ich arbeite mit Win 11 und Office 365.

 

 

 

 

 

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen