R
RB Smissaert
Wrote some code that will add line numbers to procedures that contain
certain strings.
This works with the free MZ-Tools add-in and all working fine and saving a
lot of time.
There is only one small problem and that is I haven't managed to always keep
the IDE window
invisible. This is better as if this window becomes visible then the code
will run a lot slower
as it has to update all the screens.
This is the full code:
Sub AddLineNumbersToErlProcs()
Dim i As Long
Dim n As Long
Dim c As Long
Dim x As Long
Dim WB As Workbook
Dim VBProj As VBProject
Dim VBC As VBComponent
Dim VBProjectForLineNumbers As VBProject
Dim strFile As String
Dim strFileToNumber As String
Dim msgResult As VbMsgBoxResult
Dim cmb As CommandBarControl
Dim cmbLineNumbers As CommandBarControl
Dim strPreviousProc As String
Dim strCurrentProc As String
Dim bHasLineNumber As Boolean
Dim strPreviousParentName As String
For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Add line numbers (if Procedure has Erl) to this
project?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjectForLineNumbers = VBProj
strFileToNumber = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next
If VBProjectForLineNumbers Is Nothing Then
Exit Sub
End If
Application.VBE.MainWindow.Visible = True
'find the MZ-Tools add line numbers button
'-----------------------------------------
For Each cmb In Application.VBE.CommandBars("MZ-Tools 3.0").Controls
If cmb.Caption = "Add Line Numbers" Then
Set cmbLineNumbers = cmb
Exit For
End If
Next
If cmbLineNumbers Is Nothing Then
MsgBox "Could not find the MZ-Tools Add line numbers button!", , _
"adding line numbers"
Exit Sub
End If
Application.VBE.MainWindow.Visible = False
Application.Cursor = xlWait
For Each VBC In VBProjectForLineNumbers.VBComponents
With VBC.CodeModule
For i = .CountOfDeclarationLines + 1 To .CountOfLines
strCurrentProc = .ProcOfLine(i, vbext_pk_Proc)
If strCurrentProc <> "AddLineNumbersToErlProcs" Then
If InStr(1, .Lines(i, 1), " Erl ", vbBinaryCompare) > 0 Or _
InStr(1, .Lines(i, 1), "Erl, ", vbBinaryCompare) > 0 Or _
InStr(1, .Lines(i, 1), "CStr(Erl)", vbBinaryCompare) > 0 And _
(strCurrentProc <> strPreviousProc Or Len(strPreviousProc) = 0)
Then
bHasLineNumber = False
If Asc(Left$(.Lines(i, 1), 1)) > 48 And _
Asc(Left$(.Lines(i, 1), 1)) < 58 Then
bHasLineNumber = True
End If
x = 1
If bHasLineNumber = False Then
Do Until Right$(.Lines(i - x, 1), 2) <> " _"
If Asc(Left$(.Lines(i - x, 1), 1)) > 48 And _
Asc(Left$(.Lines(i - x, 1), 1)) < 58 Then
bHasLineNumber = True
Exit Do
End If
x = x + 1
Loop
End If
If bHasLineNumber = False Then
'this avoids making the IDE window visible, which otherwise
'can happen occasionally, slowing the procedure down a lot
'it still can become visible hence the
'Application.VBE.MainWindow.Visible = False
'----------------------------------------------------------
If .Parent.Name <> strPreviousParentName Then
.Parent.Activate
If Application.VBE.MainWindow.Visible = True Then
Application.VBE.MainWindow.Visible = False
End If
End If
.CodePane.SetSelection i, 1, i, 1
cmbLineNumbers.Execute
c = c + 1
Application.StatusBar = " " & c & " procedures done. " &
_
"Last done: " & strCurrentProc
strPreviousParentName = .Parent.Name
End If
strPreviousProc = strCurrentProc
End If
End If
Next i
End With
Next VBC
MsgBox "Added line numbers to " & c & " procedures", , _
"adding line numbers"
With Application
.Cursor = xlDefault
.StatusBar = False
End With
End Sub
Any suggestions how to do handle this better?
RBS
certain strings.
This works with the free MZ-Tools add-in and all working fine and saving a
lot of time.
There is only one small problem and that is I haven't managed to always keep
the IDE window
invisible. This is better as if this window becomes visible then the code
will run a lot slower
as it has to update all the screens.
This is the full code:
Sub AddLineNumbersToErlProcs()
Dim i As Long
Dim n As Long
Dim c As Long
Dim x As Long
Dim WB As Workbook
Dim VBProj As VBProject
Dim VBC As VBComponent
Dim VBProjectForLineNumbers As VBProject
Dim strFile As String
Dim strFileToNumber As String
Dim msgResult As VbMsgBoxResult
Dim cmb As CommandBarControl
Dim cmbLineNumbers As CommandBarControl
Dim strPreviousProc As String
Dim strCurrentProc As String
Dim bHasLineNumber As Boolean
Dim strPreviousParentName As String
For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Add line numbers (if Procedure has Erl) to this
project?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjectForLineNumbers = VBProj
strFileToNumber = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next
If VBProjectForLineNumbers Is Nothing Then
Exit Sub
End If
Application.VBE.MainWindow.Visible = True
'find the MZ-Tools add line numbers button
'-----------------------------------------
For Each cmb In Application.VBE.CommandBars("MZ-Tools 3.0").Controls
If cmb.Caption = "Add Line Numbers" Then
Set cmbLineNumbers = cmb
Exit For
End If
Next
If cmbLineNumbers Is Nothing Then
MsgBox "Could not find the MZ-Tools Add line numbers button!", , _
"adding line numbers"
Exit Sub
End If
Application.VBE.MainWindow.Visible = False
Application.Cursor = xlWait
For Each VBC In VBProjectForLineNumbers.VBComponents
With VBC.CodeModule
For i = .CountOfDeclarationLines + 1 To .CountOfLines
strCurrentProc = .ProcOfLine(i, vbext_pk_Proc)
If strCurrentProc <> "AddLineNumbersToErlProcs" Then
If InStr(1, .Lines(i, 1), " Erl ", vbBinaryCompare) > 0 Or _
InStr(1, .Lines(i, 1), "Erl, ", vbBinaryCompare) > 0 Or _
InStr(1, .Lines(i, 1), "CStr(Erl)", vbBinaryCompare) > 0 And _
(strCurrentProc <> strPreviousProc Or Len(strPreviousProc) = 0)
Then
bHasLineNumber = False
If Asc(Left$(.Lines(i, 1), 1)) > 48 And _
Asc(Left$(.Lines(i, 1), 1)) < 58 Then
bHasLineNumber = True
End If
x = 1
If bHasLineNumber = False Then
Do Until Right$(.Lines(i - x, 1), 2) <> " _"
If Asc(Left$(.Lines(i - x, 1), 1)) > 48 And _
Asc(Left$(.Lines(i - x, 1), 1)) < 58 Then
bHasLineNumber = True
Exit Do
End If
x = x + 1
Loop
End If
If bHasLineNumber = False Then
'this avoids making the IDE window visible, which otherwise
'can happen occasionally, slowing the procedure down a lot
'it still can become visible hence the
'Application.VBE.MainWindow.Visible = False
'----------------------------------------------------------
If .Parent.Name <> strPreviousParentName Then
.Parent.Activate
If Application.VBE.MainWindow.Visible = True Then
Application.VBE.MainWindow.Visible = False
End If
End If
.CodePane.SetSelection i, 1, i, 1
cmbLineNumbers.Execute
c = c + 1
Application.StatusBar = " " & c & " procedures done. " &
_
"Last done: " & strCurrentProc
strPreviousParentName = .Parent.Name
End If
strPreviousProc = strCurrentProc
End If
End If
Next i
End With
Next VBC
MsgBox "Added line numbers to " & c & " procedures", , _
"adding line numbers"
With Application
.Cursor = xlDefault
.StatusBar = False
End With
End Sub
Any suggestions how to do handle this better?
RBS