AW: VBA - SUBs prokotollieren
17.08.2017 12:02:33
fcs
Hallo Walter,
im Prinzip ähnlicher Ansatz wie Rainer - protokolliert werden jedochName und Startzeit.
Es wird aber ein Daten-Array für die Protokollierung benutzt.
Zum Schluss wird das Protokoll in einem Tabellenblatt ausgegeben.
In jedes Makro, das protokolliert werden soll, muss in der 1. Zeile bzw. unmittelbar nach der Deklaration der Variablen das Makro zum Protokollieren eingefügt werden.
Der Aufruf am Ende zur Erfasung der Ende-Zeit oder anderer Infos muss nicht unbedingt sein.
Über die Variable bolMakeProtokoll im Beginn-Makro kannst du vorgeben, ob ein Protokoll erstellt werden soll.
Gruß
Franz
'Code zum Protokollieren von Makroabläufen in einem allgemeinen Modul der Datei
Option Explicit
'Variablen für Protokoll
Public pProtokoll(), pCount As Long, bolMakeProtokoll As Boolean
'Deklarationen für Timer-Funktion
Private Declare Function getFrequency Lib "kernel32" _
Alias "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" _
Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Public Function MicroTimer() As Double
' Returns seconds.
Dim cyTicks1 As Currency
Static cyFrequency As Currency
MicroTimer = 0
' Get frequency.
If cyFrequency = 0 Then getFrequency cyFrequency
' Get ticks.
getTickCount cyTicks1
' Seconds
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function
'Makro zum Erfassen der Protokolleinträge
Public Sub prcProtokoll(strProcedureName As String, Optional bolStart As Boolean = True, _
Optional var3 As Variant)
If bolMakeProtokoll = False Then Exit Sub
If bolStart = True Then
pCount = pCount + 1
ReDim Preserve pProtokoll(1 To 3, 1 To pCount)
pProtokoll(1, pCount) = strProcedureName
pProtokoll(2, pCount) = MicroTimer 'Prozedur wurde gestartet um
pProtokoll(3, pCount) = ""
Else
If IsMissing(var3) Then var3 = MicroTimer
pProtokoll(3, pCount) = var3
End If
End Sub
'Code in beliebigen Modulen in der Datei
Sub Beginn()
'vorbereiten Protokollerstellung
bolMakeProtokoll = True 'False = Es wird kein Protokoll erstellt
'Protokoll zurücksetzen
Erase pProtokoll
pCount = 0
'Protokoll starten
Call prcProtokoll("Beginn")
'Do something important
Call Step1
If VBA.Int((10 - 1) * Rnd()) + 1 > 5 Then
Call Step2
Else
Call Step3
End If
Benden:
If pCount > 0 Then
pProtokoll(3, 1) = MicroTimer 'Ende des Beginn-Makros eintragen
'Protokoll in neues Blatt ausgeben
Dim wkbProtokoll As Workbook
Set wkbProtokoll = Application.Workbooks.Add(Template:=xlWBATWorksheet)
With wkbProtokoll.Worksheets(1)
.Cells(1, 1) = "Makro-Procedur"
.Cells(1, 2) = "Start-Sekunde"
.Cells(1, 3) = "Ende-Info"
.Cells(2, 1).Resize(pCount, 3) = Application.WorksheetFunction.Transpose(pProtokoll)
.Columns(2).NumberFormat = "#,##0.0000"
.Columns(3).NumberFormat = "#,##0.0000"
.Columns.AutoFit
End With
Erase pProtokoll
pCount = 0
Else
' MsgBox "Prozeduraufrufe nicht protokolliert"
End If
End Sub
Sub Step1()
Dim lngK As Long
Call prcProtokoll("Step1")
'Do something important
For lngK = 1 To 250000
Next
Call prcProtokoll("", bolStart:=False, var3:=Format(MicroTimer, "#,##0.0000") & " Step1 bis _
End gelaufen")
End Sub
Sub Step2()
Call prcProtokoll("Step2")
'Do something important
Application.Wait Now + TimeSerial(0, 0, 1)
Call prcProtokoll("", bolStart:=False)
End Sub
Sub Step3()
Call prcProtokoll("Step3")
'Do something important
MsgBox "Testmeldung Step 3", vbOKOnly, "Test Procedure-Protokoll"
Call prcProtokoll("", bolStart:=False)
End Sub