sites.fastspring.com
Option Explicit
Public Sub CleanVBAModules()
DeleteCommentsFromVBAModules ThisWorkbook, True, True
End Sub
Private Sub DeleteCommentsFromVBAModules(ByVal argWb As Workbook, Optional ByVal RemoveIndent As Boolean = False, Optional ByVal RemoveBlankLines As Boolean = False)
Dim LineText As String, TempText As String
Dim LineNumber As Long, CmmtPos As Long
Dim HasLineBreak As Boolean, LineBreaks As Long
Dim i As Long
For i = 1 To argWb.VBProject.VBComponents.Count
With argWb.VBProject.VBComponents(i).CodeModule
For LineNumber = .CountOfLines To 1 Step -1
LineText = IIf(RemoveIndent, Trim$(.Lines(LineNumber, 1)), .Lines(LineNumber, 1))
If Not Trim$(LineText) = "DO_NOT_TOUCH = " & """" & "DO_NOT_TOUCH" & """" Then
HasLineBreak = GetLineBreaks(LineText, LineBreaks)
CmmtPos = GetCmmtPos(LineText, 1)
Select Case CmmtPos
Case 0
If Trim$(LineText) = vbNullString And RemoveBlankLines Then
.DeleteLines LineNumber, 1
Else
If Len(LineText) > 0 And RemoveIndent Then
.ReplaceLine LineNumber, LineText
End If
End If
Case 1
If HasLineBreak Then
.DeleteLines LineNumber + 1, LineBreaks
LineBreaks = 0
End If
.DeleteLines LineNumber, 1
Case Else
TempText = Left(LineText, CmmtPos - 1)
If Len(Trim$(TempText)) > 0 Then
.ReplaceLine LineNumber, TempText
Else
.DeleteLines LineNumber, 1
End If
If HasLineBreak Then
.DeleteLines LineNumber + 1, LineBreaks
LineBreaks = 0
End If
End Select
Else
Exit For
End If
Next LineNumber
End With
Next i
End Sub
Private Function GetLineBreaks(ByRef argText As String, ByRef argLineBreaks As Long) As Boolean
If Right$(argText, 1) = "_" Then
argLineBreaks = argLineBreaks + 1
GetLineBreaks = True
Else
argLineBreaks = 0
End If
End Function
Private Function GetCmmtPos(ByRef argText As String, ByVal argSearchPos As Long) As Long
Dim DQPos As Long
GetCmmtPos = InStr(argSearchPos, argText, "'")
If GetCmmtPos > 0 Then
DQPos = InStr(argSearchPos, argText, """")
If DQPos > 0 Then
If GetCmmtPos > DQPos Then
DQPos = InStr(GetCmmtPos, argText, """")
If DQPos > 0 Then
GetCmmtPos = GetCmmtPos(argText, DQPos)
End If
End If
End If
End If
End Function
Private Sub DO_NOT_TOUCH_DUMMY_SUB()
Dim DO_NOT_TOUCH As String
DO_NOT_TOUCH = "DO_NOT_TOUCH"
End SubYou are welcome and thanks for letting me know (happy with Google Translate)
' = = = = Example 1 = = = = = = = = = = = = = = = = = = = = = =
DeleteCommentsFromVBAModules ActiveWorkbook, True, True
' = = = = Example 2a = = = = = = = = = = = = = = = = = = = = = =
Dim oWb As Workbook, FullName As String
' open workbook directly using hardcoded file path and name
FullName = "C:\Users\Excelpromax123\Documents\SomeWorkbook.xlsm"
Set oWb = Application.Workbooks.Open(FullName)
' access VBA project of that workbook
If Not oWb Is Nothing Then
DeleteCommentsFromVBAModules oWb, True, True
End If
' = = = = Example 2b = = = = = = = = = = = = = = = = = = = = = =
Dim oWb As Workbook, FullName As String
' open workbook through file open dialog
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Macro Workbooks", "*.xlsm"
.Filters.Add "All Files", "*.*"
.FilterIndex = 1
.Show
If .SelectedItems.Count > 0 Then
FullName = .SelectedItems(1)
Set oWb = Application.Workbooks.Open(FullName)
' access VBA project of that workbook
DeleteCommentsFromVBAModules oWb, True, True
Else
' cancel was pressed, do nothing
End If
End With
