![]() |
Useful code
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 |
Useful code
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 "RB Smissaert" wrote in message ... 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 |
All times are GMT +1. The time now is 07:31 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com