Bildschirm aus, Application.StatusBar an
30.03.2022 19:33:50
Siegie
wie kann ich bei einem durchlaufen einer Schlaufe, den Bildschirm ausschalten (einfrieren) und mir über Application.StatusBar anzeigen lassen wo das Makro momentan arbeitet und was es macht.
Ich habe alles möglich bereits getestet, meistens funktioniert es beim ersten Start nicht, wird nichts angezeigt, wenn ich aber mit ESC unterbreche und dann mit F5 das Makro weiterlaufen lasse, sehe ich genau das was ich möchte, StatusBar zeigt mir an wo das Makro sich eben befindet und was gerade ausgewertet wird, am restlichen Bildschirm ab und zu ein Flackern oder kurzes einblenden und anschließendem ausblenden des angezeigten, am Bildschirm.
Beim Durchlaufen dieser Schlaufe werden natürlich die verschiedensten Makros aufgerufen, bekanntlich schaltet sich ja dadurch der Bildschirm immer wieder auf Anzeige TRUE.
Anbei den für die Schlaufe verwendeten Code, wäre schön, wenn mir da wieder einmal geholfen werden könnte.
Gruß Siegfried
Sub A_Auto_Buchung()
Dim OMRcvs As String
Dim dValue, LastDay As Date
Dim xEnd As Variant
Workbooks("Gesundheitswerte.xlsm").Application.ScreenUpdating = False
Call Pro_Aus(AUFZNAME)
If Range("Omron1!L3") = "" Then Call OMRON_Info
OMRcvs = Range("Omron1!F2")
Workbooks.Open Filename:=OMRcvs
Columns("A:A").Select
Selection.AutoFilter
Range("A1:A790").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
xEnd = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If Range("D" & xEnd) = "" Then xEnd = xEnd - 1
LastDay = Range("A" & xEnd)
ActiveWorkbook.Close savechanges:=False ' schließen der *.csv-Datei
If ActiveSheet.Name AUFZNAME Then Sheets(AUFZNAME).Select
Call Werte_Eing
Sheets(AUFZNAME).Shapes("Grafik 6").Visible = False
Application.ScreenUpdating = False
If IsNull(LastDay) Then LastDay = Range("Regie!F51")
Do
dValue = Range(AUFZNAME & "!C1")
If dValue >= LastDay Then Exit Do
If Sheets(AUFZNAME).Range("B19") = "gesperrt" Then ' Tagesaktualisierung
Call ErfVorb0
End If
Application.ScreenUpdating = True
Application.StatusBar = " Satz > " & Range(AUFZNAME & "!J28") - 12 & " / Anmerk. " & Range(AUFZNAME & "!C16") & " / " & Range(AUFZNAME & "!F16").Text & ")"
Application.ScreenUpdating = False
If Sheets(AUFZNAME).Range("B19") "gesperrt" And Sheets(AUFZNAME).Range("B3") = 0 Then ' nächsten Tag einlesen
Call Tag_Aktu
End If
If Sheets(AUFZNAME).Range("H19") > 0 And Sheets(AUFZNAME).Range("D3") = 0 And Sheets(AUFZNAME).Range("I19") = 0 Then
Call Wo_Sich0
End If
Loop
MsgBox "Abbruch durch Ergebnis: " & dValue
Application.StatusBar = False
Call Pro_Aus("Regie")
Range("B2").Select
Call Pro_Aus(AUFZNAME)
Sheets(AUFZNAME).Shapes("Grafik 6").Visible = False
Range("A13").Select
End Sub