Useful code

[RB Smissaert]

As I have a very large .xla where I have to first remove all line numbers,
then remove all comments, indentations and blank lines and then add line
numbers to the procedures with the whole exact word Erl I made some code
that automates this for me, with the help of the great MZ-Tools. The time
consuming bit is the last bit, re-adding the line
numbers, so that is what this code does and maybe it is (with modifications)
of use to somebody:


Sub AddLineNumbersToErlProcs()

Dim i As Long
Dim c 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

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 InStr(1, .Lines(i, 1), " Erl ", vbBinaryCompare) > 0 Or _
InStr(1, .Lines(i, 1), " Erl, ", vbBinaryCompare) > 0 And _
(strCurrentProc <> strPreviousProc Or Len(strPreviousProc) = 0)
Then
If strCurrentProc <> "AddLineNumbersToErlProcs" Then
.CodePane.SetSelection i, 1, i, 1
cmbLineNumbers.Execute
c = c + 1
Application.StatusBar = " " & c & " procedures done. " & _
"Now doing " & strCurrentProc
strPreviousProc = strCurrentProc
End If
End If
Next
End With
Next

With Application
.Cursor = xlDefault
.StatusBar = False
End With

End Sub


It will need a reference to the VBE Extensibility library.


RBS

 

[RB Smissaert]

This is a bit better as it will only run the MZ-Tools procedure if there are
no line numbers yet,
making it faster:

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

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 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
.Parent.Activate
.CodePane.SetSelection i, 1, i, 1
cmbLineNumbers.Execute
c = c + 1
Application.StatusBar = " " & c & " procedures done. " &
_
"Last done: " & strCurrentProc
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


RBS