Fortschrittanzeige zählt nicht
29.08.2019 13:14:32
Alex
Wo ist der Fehler ?
Option Explicit
Sub ShowDialog()
Load ProgressDlg 'Dies vor der Schleife aufrufen
ProgressDlg.Show vbModeless
End Sub
Sub Main() 'Nur zur Demonstration, hier wird deine Schleife simuliert
Dim i As Long, tot As Long
tot = 1 ' Anzahl der Durchl?ufe muss VORHER feststehen
ProgressDlg.Caption = "Prosessing data, please wait..." 'Titel des Progressbar
ShowDialog
For i = 1 To tot 'das ist DEINE Schleife
If i Mod 10 = 0 Then ProgressBar (i / tot)
'Hier muss die sub aufgerufen werden
'Hier wird z.B. bei jeder 100. Iteration neu gezeichnet, damit der Rechner nicht gestresst wird
'bei einer Schleife mit 10.000 Iterationen muss ja nicht unbedingt 10.000 mal die Progressbar aufgerufen werden.
'Mein Code:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Workbooks.Open(Filename:= _
"G:\9930 PRODUCTION\public\DATA_REPORT_SERVER\APR19.xlsm").RunAutoMacros Which _
:=xlAutoOpen
Application.Calculation = xlAutomatic
Range("E2").Select
ActiveWorkbook.Connections("DBProduktionDECL2019").Refresh
ActiveWindow.Close
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call Calculate
Unload ProgressDlg
End Sub
Public Sub ProgressBar(PctDone As Single)
With ProgressDlg
.lblDone.Width = PctDone * (.lblRemain.Width - 2)
.lblPct.Caption = Format(PctDone, "0%")
End With
DoEvents
ProgressDlg.Repaint
End Sub