MsgBox Finder erster Versuch ;-)

28/09/2008 - 18:23 von Günter Gerold | Report spam
Hallo NG,

der folgende Code sollte nur den Inhalt der MsgBoxen im VBA-Code anzeigen.
Es ist der Verweis auf Microsoft Visual Basic for Applications Extensibility 5.3 nötig.
Aufruf : fncFindMsgBoxes

Übersieht der Code etwas ausser Eval "M" & "s" & "g" & "B" & "o" & "x" & "(" & """" & "!" & """" & ")" ?

Public Function fncFindMsgBoxes()

Dim i As Long
Dim strText As String
Dim strDanach As String
Dim strVor As String
Dim strFinde1 As String
Dim StartLine As Long
Dim EndLine As Long
Dim StartLineBuffer As Long
Dim StartColumn As Long
Dim EndColumn As Long
Dim y As VBIDE.VBComponent

strFinde1 = "MsgBox"
For Each y In Application.VBE.ActiveVBProject.VBComponents
StartLine = 0
EndLine = y.CodeModule.CountOfLines
Do While y.CodeModule.Find(strFinde1, StartLine, StartColumn, EndLine, EndColumn) = True 'Den ganzen Code zeilenweise
If StartLineBuffer <> StartLine Then i = 1
strText = y.CodeModule.Lines(StartLine, Abs(EndLine - StartLine) + 1) 'Die Zeile in strText
strText = GibGanzeZeile(y, StartLine) 'Die Zeile umbruchbereinigt
strText = ZeilenSpalter(strText, i)
strText = strText
strVor = Left(strText, Nz(InStr(strText, strFinde1)) - 1) 'Der Teil vor dem Befehl
If istKommentar(strVor) = False Then 'Ist der Befehl im einem Kommentar?
strDanach = Right(strText, Len(strText) - Nz(InStr(strText, strFinde1)) - Len(strFinde1) + 1)
If ((Left(strDanach, 1) = " ") Or (Left(strDanach, 1) = "(") And Right(strVor, 1) = " ") Then
If (Left(strDanach, 1) = "(") Then 'wenn Klammerauf, dann Klammern zàhlen um das Ende der MsgBox zu finden
strDanach = KlammernZaehler(strDanach)
ElseIf (Left(strDanach, 1) = " ") Then
strDanach = KommentarWeg(strDanach)
End If
MsgBox strDanach 'Dieser Kommentar muß weg
End If
End If
i = i + 1
StartColumn = EndColumn
StartLineBuffer = StartLine
EndLine = y.CodeModule.CountOfLines
EndColumn = 255
Loop
Next
End Function

Private Function GibGanzeZeile(Modul As VBIDE.VBComponent, ByVal lngStart As Long) As String
'Dank an Thomas Möller www.team-moeller.de
'Variablen deklarieren
Dim mdl As VBIDE.CodeModule
Dim strGanzZeile As String
Dim strZeile As String
Dim lngStartAb As Long
Dim lngStartAuf As Long
Set mdl = Modul.CodeModule

'Vorhergehende Zeilen
lngStartAuf = lngStart - 1
strZeile = Trim$(mdl.Lines(lngStartAuf, 1))
Do While Right$(strZeile, 1) = "_"
strGanzZeile = Left$(strZeile, Len(strZeile) - 1) & strGanzZeile
lngStartAuf = lngStartAuf - 1
strZeile = Trim$(mdl.Lines(lngStartAuf, 1))
Loop
'Folgende Zeilen
lngStartAb = lngStart
strZeile = Trim$(mdl.Lines(lngStartAb, 1))
Do While Right$(strZeile, 1) = "_"
strGanzZeile = strGanzZeile & Left$(strZeile, Len(strZeile) - 1)
lngStartAb = lngStartAb + 1
strZeile = Trim$(mdl.Lines(lngStartAb, 1))
Loop
strGanzZeile = strGanzZeile & strZeile

GibGanzeZeile = strGanzZeile

End Function

Private Function istKommentar(ByVal strText As String) As Boolean
Dim lngPos As Long
Dim lngCount As Long
Dim lngAktHochkomma As Long
Dim strPuffer As String
Dim strzeichen As String
strzeichen = Chr(34)

Do While Nz(InStr(strText, "'")) > 0
lngPos = 1
lngAktHochkomma = Nz(InStr(lngPos, strText, "'"))
strPuffer = Left(strText, lngAktHochkomma - 1)
Do While Nz(InStr(lngPos, strPuffer, strzeichen))
lngPos = Nz(InStr(lngPos, strText, strzeichen))
lngCount = lngCount + 1
lngPos = lngPos + 1
Loop
If lngCount Mod 2 = 0 Then
istKommentar = True
Exit Function
End If
Loop
istKommentar = False
End Function

Private Function KlammernZaehler(ByVal strText As String) As String
Dim i As Integer
Dim lngCount As Long
Dim strArray() As String
ReDim strArray(Len(strText))

For i = 1 To Len(strText)
strArray(i) = Mid$(strText, i, 1)
Next i

For i = 1 To Len(strText)
Select Case strArray(i)
Case "("
lngCount = lngCount + 1
Case ")"
lngCount = lngCount - 1
Case Chr(34)
i = i + 1
Do While i < Len(strText)
If strArray(i) = Chr(34) Then
Exit Do
End If
i = i + 1
Loop
End Select
If lngCount = 0 Then
KlammernZaehler = Left(strText, i)
Exit Function
End If
Next i
End Function

Private Function KommentarWeg(ByVal strText As String) As String
Dim i As Integer
Dim lngCount As Long
Dim strArray() As String
ReDim strArray(Len(strText))

For i = 1 To Len(strText)
strArray(i) = Mid$(strText, i, 1)
Next i

For i = 1 To Len(strText)
Select Case strArray(i)
Case "'"
KommentarWeg = Left(strText, i - 1)
Exit Function
Case Chr(34)
i = i + 1
Do While i < Len(strText)
If strArray(i) = Chr(34) Then
Exit Do
End If
i = i + 1
Loop
End Select
Next i
KommentarWeg = strText
End Function
Private Function ZeilenSpalter(ByVal strText As String, ByVal lngTeilNummer As Long) As String
Dim i As Integer
Dim lngCount As Long
Dim startpos As Long
Dim strArray() As String
ReDim strArray(Len(strText))
For i = 1 To Len(strText)
strArray(i) = Mid$(strText, i, 1)
Next i
If lngTeilNummer = 1 Then ZeilenSpalter = strText
For i = 1 To Len(strText)
Select Case strArray(i)
Case ":"
lngCount = lngCount + 1
If lngCount = lngTeilNummer - 1 Then
startpos = i + 1
ElseIf lngCount = lngTeilNummer Then
If startpos = 0 Then startpos = 1
ZeilenSpalter = Mid(strText, startpos, i - startpos)
Exit Function
End If
Case Chr(34)
i = i + 1
Do While i < Len(strText)
If strArray(i) = Chr(34) Then
Exit Do
End If
i = i + 1
Loop
Case Else

End Select
Next i
If lngCount > 0 And startpos > 0 Then
ZeilenSpalter = Mid(strText, startpos, i + 1 - startpos)
Exit Function
End If
If lngCount < (lngTeilNummer - 1) Then
ZeilenSpalter = ""
End If
End Function

Günter
 

Lesen sie die antworten

#1 Peter Doering
29/09/2008 - 12:32 | Warnen spam
Hallo,

Günter Gerold wrote:

der folgende Code sollte nur den Inhalt der MsgBoxen im VBA-Code anzeigen.
Es ist der Verweis auf Microsoft Visual Basic for Applications Extensibility 5.3 nötig.
Aufruf : fncFindMsgBoxes

Übersieht der Code etwas ausser Eval "M" & "s" & "g" & "B" & "o" & "x" & "(" & """" & "!" & """" & ")" ?

Public Function fncFindMsgBoxes()

Dim i As Long
Dim strText As String
Dim strDanach As String
Dim strVor As String
Dim strFinde1 As String
Dim StartLine As Long
Dim EndLine As Long
Dim StartLineBuffer As Long
Dim StartColumn As Long
Dim EndColumn As Long
Dim y As VBIDE.VBComponent

strFinde1 = "MsgBox"
For Each y In Application.VBE.ActiveVBProject.VBComponents
StartLine = 0



Hier fehlt ein Reset von i:

i = 1

Ansonsten gibt der ZeilenSpalter abhaengig vom Vorgaenger einen falschen
Rueckgabewert.

EndLine = y.CodeModule.CountOfLines
Do While y.CodeModule.Find(strFinde1, StartLine, StartColumn, EndLine, EndColumn) = True 'Den ganzen Code zeilenweise
If StartLineBuffer <> StartLine Then i = 1
strText = y.CodeModule.Lines(StartLine, Abs(EndLine - StartLine) + 1) 'Die Zeile in strText
strText = GibGanzeZeile(y, StartLine) 'Die Zeile umbruchbereinigt
strText = ZeilenSpalter(strText, i)
strText = strText
strVor = Left(strText, Nz(InStr(strText, strFinde1)) - 1) 'Der Teil vor dem Befehl



Gruss - Peter

Anmeldung zur 11. AEK unter www.donkarl.com/?AEK
Mitglied im http://www.dbdev.org
FAQ: http://www.donkarl.com

Ähnliche fragen