Prozedurnamen während Laufzeit auslesen
John Curio
im MZ Tool kann man sich die Fehlerroutine einfügen lassen. Dabei wird der
Prozedurname und der Modul Name eingefügt.
Finde ich klasse, aber da ich viel Code zwischen verschiedenen VBA-Projekten
hin und her kopiere, würde ich gerne den Prozedurnamen während der Laufzeit
generieren.
Geht das irgendwie?
Danke
Johannes
Peter Schleif
>
> würde ich gerne den Prozedurnamen während der Laufzeit generieren.
Wurde hier vor einiger Zeit schon mal angefragt.
Leider hat der damalige OP kein feedback gegeben. Darum weiß ich nicht
ob es funktioniert.
Peter
stefan onken
> Wurde hier vor einiger Zeit schon mal angefragt.
>
>
> Leider hat der damalige OP kein feedback gegeben. Darum weiß ich nicht
> ob es funktioniert.
>
> Peter
ich hatte es damals (an)getestet, dann aber wieder vergessen.
Das einfügen der Codezeilen funktioniert gut, aber wegen der Codezeile
Set CodeMod = Application.VBE.ActiveCodePane.CodeModule
immer nur für das aktive (Klassen)Modul.
dh, bei mehreren Modulen muss man die Module einzeln aktivieren und
InsertProcedureNameIntoProcedures eben mehrmals starten.
Kein wirkliches Manko, nur eine kleine Unbequemlichkeit.
Wenn Makronamen geändert werden, muss auch
InsertProcedureNameIntoProcedures gestartet werden, um die Änderung
anzupassen.
Eine evtl schon vorhandene Fehlerbehandlung muss dann manuell
angepasst werden.
Eine wirkliche dynamische Erfassung des Moduls/Prozedurnamens ist das
nicht, aber die Verbindung mit MZtools kann einiges an Tipparbeit
ersparen.
Gruß
stefan
John Curio
1:0 Excel Newsgroup - Access Newsgroup :-)
"John Curio" <J_C...@gmx.de> schrieb im Newsbeitrag
news:ufEyIU8x...@TK2MSFTNGP06.phx.gbl...
stefan onken
On 6 Jun., 16:20, "John Curio" <J_Cu...@gmx.de> wrote:
> Danke!
>
> 1:0 Excel Newsgroup - Access Newsgroup :-)
>
bei MsgBox Application.VBE.ActiveCodePane.CodeModule
ist der Modulname zB Modul1 und nicht Modul2, wenn im VBA-Editor
Modul1 aktiviert ist, du aber ein Makro aus Modul2 startest.
Gruß
stefan
John Curio
Versuche gerade die Funktion
InsertProcedureNameIntoProcedures
auszuprobieren.
Was habe ich bis jetzt gemacht:
1. Verweis "Microsoft Visual Basic For Applications Extensibility 5.3."
2. Den Code von der Homepage in ein Modul von mir getan.
3. Das Modul ausgeführt.
Er sollte ja jetzt nach
"Sub Versuch"
die Zeile
const = MeinProdNamen" einfügen.
Macht er aber leider nicht.
Wie war das bei Dir?
"stefan onken" <steo...@web.de> schrieb im Newsbeitrag
news:415206c1-0dc0-4655...@k30g2000hse.googlegroups.com...
John Curio
nicht ganz dynamisch, aber man kann es dynamisch einstellen.
Ich habe in meinen Programmierungen eine Public Variable, welche ich
umstelle zwischen "Entwicklung" und "Anwendung".
Wenn Entwicklung, dann durchläuft er bei jedem Start die Prozedur
InsertProcedureNameIntoProcedures
Dann habe ich die Input-Abfrage durch eine Konstante ersetzt und habe durch
den Aufruf immer die aktuellen Prod-Namen ... und schon ist es Dynamisch :-)
... wenn es mal bei mir klappt.
Hilft das vielleicht weiter?
"stefan onken" <steo...@web.de> schrieb im Newsbeitrag
news:41e8783f-836a-4f2f...@k13g2000hse.googlegroups.com...
John Curio
Gruß
stefan
Hallo
mein Einspruch von vorhin - das funktioniert nicht - ist falsch.
Es funktioniert nur im aktivierten Modul.
Wie lautet die For ... Next-Schleife, um alles Module zu durchwandern?
Gruß
Johannes
stefan onken
John Curio wrote:
> "stefan onken" <steo...@web.de> schrieb im Newsbeitrag
> news:415206c1-0dc0-4655...@k30g2000hse.googlegroups.com...
> hallo John,
>
> mein Einspruch von vorhin - das funktioniert nicht - ist
> falsch. Es funktioniert nur im aktivierten Modul.
genau, wegen ActiveCodePane
> Wie lautet die For ... Next-Schleife, um alles Module zu
> durchwandern?
das müsste sein
For Each codemod In ThisWorkbook.VBProject.VBComponents
'code
Next
allgemeines zum VBA-Editor:
http://www.jumper.ch/Artikel/215.htm
Gruß
stefan
John Curio
Werde mich morgen mal hinsetzen und das versuchen auszuarbeiten. Bericht
folgt.
Hast Du das in irgendeiner Form weiter ausgebaut?
Johannes
John Curio
moin allerseits,
moin stefan,
Der Versuch, den Code von Chip Pearson anzupassen, schlägt leider fehl.
Ich habe den Code genommen und vor dem Do Until die For ... Next-Schleife
eingebaut, die alle Projekte und
Selbstverständlich habe ich das ActiveCodePane durch myComponent ersetzt.
Ergebnis:
Er schreibt nur in das 1. Modul die Konstante "NameDerProzedur", obwohl er
alle Module durchläuft - siehe debug.print
Wo ist der Hacken?
Danke für die Hilfe.
Johannes
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Option Compare Database
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modInsertProcNames
' By Chip Pearson, www.cpearson.com, ch...@cpearson.com
'
' This module contains the InsertProcedureNameIntoProcedure and
supporting
' procedures.
'
' InsertProcedureNameIntoProcedure will insert a CONST statement at the
' top of each procedure in the
Application.VBE.ActiveCodePane.CodeModule.
' The user selects the name of the constant (e.g., "C_PROC_NAME") and
the
' code insert statements like
' Const C_PROC_NAME = "InsertProcedureNameIntoProcedure"
' at the beginning of each procedure. It supports procedures whose
Declaration
' spans more than one line, e.g.,
' Public Function Test( X As Integer, _
' Y As Integer, _
' Z As Integer)
' If comment lines appear DIRECTLY below the procedured declaration (no
blank
' lines between the declaration and the start of the comments), the
CONST
' statement is placed directly below the comment block. If a constant
already
' exists with name user specified name, that constant declaration is
deleted and
' replaced with the new CONST line.
' Examlpe: It will accommodate comment blocks that immediately follow
the procedure declarations
' (no blank lines between the end of the procedure declaration lines and
the first comment line).
' In this case, the constant is inserted AFTER the comments.
' Sub BBB(X As Integer, _
' Y As Integer, _
' Z As Integer)
' ''''''''''''''''''''''''''
' ' BBB In Comments
' ''''''''''''''''''''''''''
'
' Const C_PROC_NAME = "BBB" ' <-- inserted by code
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const C_MSGBOX_TITLE = "Insert Procedure Names"
Private Const C_VBE_CONST_TAG = "__INSERTCONSTLINE__"
Private Const C_VBE_INSERT_MENU As Long = 30005
Sub InsertProcedureNameIntoProcedures()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' InsertProcedureNameIntoProcedures
' This procedure inserts a CONST statement in each procedure in the
' ActiveCodePane.CodeModule. The user is prompted for the name of
' the constant to add. If that constant already exists within each
' procedure, that line of code is deleted and replace with the
' new CONST statement.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ProcName As String
Dim ProcLine As String
Dim ProcType As VBIDE.vbext_ProcKind
Dim StartLine As Long
Dim Msg As String
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.codeModule
Dim Ndx As Long
Dim Res As Variant
Dim Done As Boolean
Dim ProcBodyLine As Long
Dim SaveProcName As String
Dim ConstName As String
Dim ValidConstName As Boolean
Dim ConstAtLine As Long
Dim EndOfDeclaration As Long
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure there is an active project.
''''''''''''''''''''''''''''''''''''''''''''''''''
If Application.VBE.ActiveVBProject Is Nothing Then
MsgBox "There is no active project.", vbOKOnly, C_MSGBOX_TITLE
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure the ActiveProject is not locked.
''''''''''''''''''''''''''''''''''''''''''''''''''
If Application.VBE.ActiveVBProject.Protection = vbext_pp_locked Then
MsgBox "The active project is locked.", vbOKOnly, C_MSGBOX_TITLE
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure there is an active code pane
''''''''''''''''''''''''''''''''''''''''''''''''''
If Application.VBE.ActiveCodePane Is Nothing Then
MsgBox "There is no active code pane.", vbOKOnly, C_MSGBOX_TITLE
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt the user for the name of the constant
' to insert.
''''''''''''''''''''''''''''''''''''''''''''''''''
ConstName = "NameDerProzedur"
'-------------------------------------------------------------------------------------------------
' Mein Code zu Durchlaufen aller Projekte, Module ...
Dim myProject As VBProject
Dim myComponent As VBComponent
Dim ModulNamen As String
' Alle Projekte durchlaufen
For Each myProject In VBE.VBProjects
' Nur ungeschützte berücksichtigen
If myProject.Protection = vbext_pp_none Then
If myProject.VBComponents.Count > 1 Then
' jetzt alle module durchlaufen.
For Each myComponent In myProject.VBComponents
'-------------------------------------------------------------------------------------------------
' Nach der Loop-Schleife sind dann, die End Ifs und das Next.
'-------------------------------------------------------------------------------------------------
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the active code module.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' orirignal: Set CodeMod = Application.VBE.ActiveCodePane.CodeModule
Set CodeMod = myComponent.codeModule
Debug.Print CodeMod.Name
'''''''''''''''''''''''''''''''''''''''''''''''''''
' Skip past any Option statement and any module-level
' variable declations. Start at the first procuedure
' in the module.
'''''''''''''''''''''''''''''''''''''''''''''''''''
StartLine = CodeMod.CountOfDeclarationLines + 1
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the procedure name that is at StartLine.
''''''''''''''''''''''''''''''''''''''''''''''''''''
ProcName = CodeMod.ProcOfLine(StartLine, ProcType)
SaveProcName = ProcName
Do Until Done
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Loop through all procedures in the module.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the body proc line (the actual declaration line,
' ignoring commnets
''''''''''''''''''''''''''''''''''''''''''''''''''''''
ProcBodyLine = CodeMod.ProcBodyLine(ProcName, ProcType)
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' See if the constant declaration already exists.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
ConstAtLine = ConstNameInProcedure(ConstName, CodeMod, ProcName,
ProcType)
If ConstAtLine > 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Const line already exist. Delete it and
' replace it.
'''''''''''''''''''''''''''''''''''''''''''
CodeMod.DeleteLines ConstAtLine, 1
CodeMod.InsertLines ConstAtLine, "CONST " & ConstName & " = " &
Chr(34) & ProcName & Chr(34)
Else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Skip past the declaration lines and the comment lines that
' immediately follow the declarations (no blank lines between
' the declarations and the comments).
' Insert the CONST declaration.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
EndOfDeclaration = EndOfDeclarationLines(CodeMod, ProcName,
ProcType)
ProcLine = EndOfCommentOfProc(CodeMod, EndOfDeclaration + 1)
CodeMod.InsertLines ProcLine + 1, "CONST " & ConstName & " = " &
Chr(34) & ProcName & Chr(34)
End If
''''''''''''''''''''''''''''''''''''''''''
' Skip StartLine to the next proc
''''''''''''''''''''''''''''''''''''''''''
StartLine = ProcBodyLine + CodeMod.ProcCountLines(ProcName,
ProcType) + 1
ProcName = CodeMod.ProcOfLine(StartLine, ProcType)
''''''''''''''''''''''''''''''''
' Special handling for the last
' procedure in the module in case
' it has blank lines following the
' end of the procedure body.
'''''''''''''''''''''''''''''''''
If ProcName = SaveProcName Then
Done = True
Else
SaveProcName = ProcName
End If
Loop
'----------------------------------------------------------------------------------------------------
Next
End If
End If
Next
'----------------------------------------------------------------------------------------------------
End Sub
'
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Jetzt folgen die benötigten Funktionen
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Function EndOfCommentOfProc(CodeMod As VBIDE.codeModule, ProcBodyLine As
Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EndOfCommentOfProc
' This returns the line number of the last comment line in a comment
block that
' IMMEDIATELY follows the procedure declaration. For example, with the
following
' code
' Function MyTest(X As Integer, _
' Y As Integer, _
' Z As Ineger)
' '''''''''''''''''''''''''''''''''''' START COMMENT BLOCK
' ' Some Comments
' '''''''''''''''''''''''''''''''''''' END COMMENT BLOCK
'
' the function will return the line number of "END COMMENT BLOCK". There
must be
' no blank lines between "Z As Integer)" and the first comment line.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Done As Boolean
Dim LineNum As String
Dim LineText As String
LineNum = ProcBodyLine
Do Until Done
LineNum = LineNum + 1
LineText = CodeMod.Lines(LineNum, 1)
If Left(Trim(LineText), 1) = "'" Then
Done = False
Else
Done = True
End If
Loop
EndOfCommentOfProc = LineNum - 1
End Function
Function IsValidConstantName(ConstName As String) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsValidConstantName
' This returns True or False indicating whether ConstName
' is a valid constant name. ConstName must not contain any
' spaces, the left-most character must be a letter, and the
' rest of the characters must be alpha or numeric or underscore
' character. Any other character is considered invalid.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim C As String
Dim N As Long
Dim CAsc As Integer
If InStr(1, ConstName, " ") > 0 Then
IsValidConstantName = False
Exit Function
End If
If IsNumeric(Left(ConstName, 1)) = True Then
IsValidConstantName = False
Exit Function
End If
For N = 2 To Len(ConstName)
C = Mid(ConstName, N, 1)
CAsc = Asc(C)
Select Case CAsc
Case Asc("A") To Asc("Z")
Case Asc("0") To Asc("9")
Case Asc("_")
Case Else
IsValidConstantName = False
Exit Function
End Select
Next N
IsValidConstantName = True
End Function
Function ConstNameInProcedure(ConstName As String, CodeMod As
VBIDE.codeModule, _
ProcName As String, _
ProcType As VBIDE.vbext_ProcKind) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ConstNameInProcedure
' This returns the line number containing the existing constant
declaration,
' or 0 if the procedure does not contain the constant declaration.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LineNum As Long
Dim LineText As String
Dim ProcBodyLine As Long
ProcBodyLine = CodeMod.ProcBodyLine(ProcName, ProcType)
For LineNum = ProcBodyLine To ProcBodyLine +
CodeMod.ProcCountLines(ProcName, ProcType)
LineText = CodeMod.Lines(LineNum, 1)
If InStr(LineText, " " & ConstName & " ") > 0 Then
ConstNameInProcedure = LineNum
Exit Function
End If
Next LineNum
End Function
Function EndOfDeclarationLines(CodeMod As VBIDE.codeModule, ProcName As
String, _
ProcType As VBIDE.vbext_ProcKind) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EndOfDeclarationLines
' This return the line number of the last declation lines. This is used
to find
' the end of declarations when the declaration span more than one line
of text
' in the code. For example, with the code
' Function MyTest(X As Integer, _
' Y As Integer, _
' Z As Integer)
' it will return the line number of "Z As Integer)", the line number of
the
' end of the declarations block.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LineNum As Long
Dim LineText As String
LineNum = CodeMod.ProcBodyLine(ProcName, ProcType)
Do Until Right(CodeMod.Lines(LineNum, 1), 1) <> "_"
LineNum = LineNum + 1
Loop
EndOfDeclarationLines = LineNum
End Function
'
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
stefan onken
> moin stefan,
>
> Der Versuch, den Code von Chip Pearson anzupassen, schlägt leider fehl.
> Ich habe den Code genommen und vor dem Do Until die For ... Next-Schleife
> eingebaut, die alle Projekte und
> Selbstverständlich habe ich das ActiveCodePane durch myComponent ersetzt.
> Ergebnis:
> Er schreibt nur in das 1. Modul die Konstante "NameDerProzedur", obwohl er
> alle Module durchläuft - siehe debug.print
> Wo ist der Hacken?
> Danke für die Hilfe.
>
> Johannes
ersetzen.
Alle Aktionen beziehen sich auf den Inhalt der Variable CodeMod, nicht
auf myComponent.
Oder du änderst die Zeile
For Each myComponent In myProject.VBComponents
For Each CodeMod In myProject.VBComponents
Gruß
stefan
John Curio
Gruß
stefan
Hi Stefan,
Danke. Habe mir Deine Idee mal angeschaut. Ist es nicht gewesen, weil es die
Zeile
Set CodeMod = myComponent.codeModule
gibt :-)
Habe aber die Lösung gefunden.
Der variabel "done" wird beim ersten Do ... loop-Laufe auf wahr gesetzt.
Beim 2. Modul wird die Variable "Done" aber nicht auf false gesetzt.
habe "Done" durch "ReachedEndOfModul" ersetzt und in zeile 175 auf false
gesetzt.
Jetzt muss ich am Wochenende noch den Projekt-Namen und den Modul-Namen
einfügen und hat man schon mal eine große Erleichertung in Kombination zum
MZ-Tool.
Ideal wäre, wenn man darüber noch die Fehlerbehandlung direkt einfügen
könnte. Aber das folgt, wenn ich mehr Zeit habe.
Die Lösung:
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Sub InsertProcedureNameIntoProcedures()
Dim ReachedEndOfModul As Boolean
Dim ProcBodyLine As Long
Dim SaveProcName As String
Dim ConstName As String
Dim ValidConstName As Boolean
Dim ConstAtLine As Long
Dim EndOfDeclaration As Long
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure there is an active project.
''''''''''''''''''''''''''''''''''''''''''''''''''
10 If Application.VBE.ActiveVBProject Is Nothing Then
20 MsgBox "There is no active project.", vbOKOnly, C_MSGBOX_TITLE
30 Exit Sub
40 End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure the ActiveProject is not locked.
''''''''''''''''''''''''''''''''''''''''''''''''''
50 If Application.VBE.ActiveVBProject.Protection = vbext_pp_locked
Then
60 MsgBox "The active project is locked.", vbOKOnly,
C_MSGBOX_TITLE
70 Exit Sub
80 End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Ensure there is an active code pane
''''''''''''''''''''''''''''''''''''''''''''''''''
90 If Application.VBE.ActiveCodePane Is Nothing Then
100 MsgBox "There is no active code pane.", vbOKOnly,
C_MSGBOX_TITLE
110 Exit Sub
120 End If
''''''''''''''''''''''''''''''''''''''''''''''''''
' Prompt the user for the name of the constant
' to insert.
''''''''''''''''''''''''''''''''''''''''''''''''''
130 ConstName = "NameDerProzedur"
Dim myProject As VBProject
Dim myComponent As VBComponent
Dim ModulNamen As String
' Alle Projekte durchlaufen
140 For Each myProject In VBE.VBProjects
' Nur ungeschützte berücksichtigen
150 If myProject.Protection = vbext_pp_none Then
160 If myProject.VBComponents.Count > 1 Then
' jetzt alle module durchlaufen.
170 For Each myComponent In myProject.VBComponents
' wird innerhalb der do loop schleife auf true gesetzt,
' wenn wir fertig sind. muss wieder auf false gesetzt werden.
175 ReachedEndOfModul = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the active code module.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' orirignal: Set CodeMod =
Application.VBE.ActiveCodePane.CodeModule
180 Set CodeMod = myComponent.codeModule
'''''''''''''''''''''''''''''''''''''''''''''''''''
' Skip past any Option statement and any module-level
' variable declations. Start at the first procuedure
' in the module.
'''''''''''''''''''''''''''''''''''''''''''''''''''
190 StartLine = CodeMod.CountOfDeclarationLines + 1
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the procedure name that is at StartLine.
''''''''''''''''''''''''''''''''''''''''''''''''''''
200 ProcName = CodeMod.ProcOfLine(StartLine, ProcType)
210 SaveProcName = ProcName
220 Do Until ReachedEndOfModul
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Loop through all procedures in the module.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get the body proc line (the actual declaration line,
' ignoring commnets
''''''''''''''''''''''''''''''''''''''''''''''''''''''
230 ProcBodyLine = CodeMod.ProcBodyLine(ProcName, ProcType)
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' See if the constant declaration already exists.
'''''''''''''''''''''''''''''''''''''''''''''''''''''
240 ConstAtLine = ConstNameInProcedure(ConstName, CodeMod,
ProcName, ProcType)
250 If ConstAtLine > 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Const line already exist. Delete it and
' replace it.
'''''''''''''''''''''''''''''''''''''''''''
260 CodeMod.DeleteLines ConstAtLine, 1
270 CodeMod.InsertLines ConstAtLine, "CONST " & ConstName & "
= " & Chr(34) & ProcName & Chr(34)
280 Else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Skip past the declaration lines and the comment lines
that
' immediately follow the declarations (no blank lines
between
' the declarations and the comments).
' Insert the CONST declaration.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
290 EndOfDeclaration = EndOfDeclarationLines(CodeMod,
ProcName, ProcType)
300 ProcLine = EndOfCommentOfProc(CodeMod, EndOfDeclaration +
1)
310 CodeMod.InsertLines ProcLine + 1, "CONST " & ConstName & "
= " & Chr(34) & ProcName & Chr(34)
320 End If
''''''''''''''''''''''''''''''''''''''''''
' Skip StartLine to the next proc
''''''''''''''''''''''''''''''''''''''''''
330 StartLine = ProcBodyLine + CodeMod.ProcCountLines(ProcName,
ProcType) + 1
340 ProcName = CodeMod.ProcOfLine(StartLine, ProcType)
''''''''''''''''''''''''''''''''
' Special handling for the last
' procedure in the module in case
' it has blank lines following the
' end of the procedure body.
'''''''''''''''''''''''''''''''''
350 If ProcName = SaveProcName Then
360 ReachedEndOfModul = True
370 Else
380 SaveProcName = ProcName
390 End If
' MsgBox "Projekt: " & myProject.Name & vbCrLf & _
"MyComponent: " & myComponent.Name & vbCrLf & _
"Modulname: " & CodeMod.Name & vbCrLf & _
"Startline: " & StartLine & vbCrLf & _
"ProcName: " & ProcName & vbCrLf & _
"ProcBodyLine: " & ProcBodyLine & vbCrLf & _
"StartLine: " & StartLine & vbCrLf & _
""
410 Loop
420 Next
430 End If
440 End If
450 Next
End Sub
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' benötigte Funktionen
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Function EndOfCommentOfProc(CodeMod As VBIDE.codeModule, ProcBodyLine As
Long) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' EndOfCommentOfProc
' This returns the line number of the last comment line in a comment
block that
' IMMEDIATELY follows the procedure declaration. For example, with the
following
' code
' Function MyTest(X As Integer, _
' Y As Integer, _
' Z As Ineger)
' '''''''''''''''''''''''''''''''''''' START COMMENT BLOCK
' ' Some Comments
' '''''''''''''''''''''''''''''''''''' END COMMENT BLOCK
'
' the function will return the line number of "END COMMENT BLOCK". There
must be
' no blank lines between "Z As Integer)" and the first comment line.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ReachedEndOfModul As Boolean
Dim LineNum As String
Dim LineText As String
LineNum = ProcBodyLine
Do Until ReachedEndOfModul
LineNum = LineNum + 1
LineText = CodeMod.Lines(LineNum, 1)
If Left(Trim(LineText), 1) = "'" Then
ReachedEndOfModul = False
Else
ReachedEndOfModul = True