#1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default 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

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,452
Default 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


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
split post code (zip code) out of cell that includes full address Concord Excel Discussion (Misc queries) 4 October 15th 09 06:59 PM
Slow code when used as VBA code instead of macro (copying visible columns) [email protected] Excel Programming 3 April 2nd 07 05:26 PM
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code. Corey Excel Programming 3 December 11th 06 05:14 AM
Protect Sheet with code, but then code will not Paste error. How do i get around this. Please read for explainations.... Corey Excel Programming 4 November 25th 06 04:57 AM
Excel code convert to Access code - Concat & eliminate duplicates italia Excel Programming 1 September 12th 06 12:14 AM


All times are GMT +1. The time now is 07:31 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"