I did notice that the Compactor didn't clean any code found in the forms

It should do and does with me.
Maybe download the add-in I uploaded to Planet Source Code some years ago
that has this in it:
http://www.planet-source-code.com/vb...33284&lngWId=1

RBS


"MikeZz" wrote in message
...
Hi RB,
This is pretty helpful as well.
I did notice that the Compactor didn't clean any code found in the forms.
Is there an easy way to do that as well or should I just copy it all to a
module, run the application, then copy it back to the form?

Thanks again for everything
MikeZz

"RB Smissaert" wrote:

Here a trimmed down version of a VB project documenter I once uploaded to
Planet Source Code.
Once you have all the procedures then it shouldn't be too difficult to
replace with a scrambled name and
do the replacements in the VBE.

Sub test()

Dim VBProj As VBProject
Dim arr

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Document this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
arr = GetProcedures(VBProj)
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If Not IsArray(arr) Then
Exit Sub
End If

Application.ScreenUpdating = False

Cells.Clear
Cells(1) = "Module name"
Cells(2) = "Module type"
Cells(3) = "Procedure name"
Cells(4) = "Procedure type"
Cells(5) = "Procedure start"
Cells(6) = "Procedure lines"

Range(Cells(1), Cells(6)).Font.Bold = True
Range(Cells(2, 1), Cells(UBound(arr) + 1, UBound(arr, 2))) = arr
Range(Cells(1), Cells(UBound(arr) + 1, UBound(arr, 2))).Columns.AutoFit

Application.ScreenUpdating = True

End Sub


Function GetProcedures(VBProj As VBProject) As Variant

Dim i As Long
Dim x As Long
Dim strStatusIndent As String
Dim VBComp As VBComponent
Dim lCodeLine As Long
Dim lProcBodyLine As Long
Dim lProcLineCount As Long
Dim strProcName As String
Dim strProcType As String
Dim strProcNamePrevious As String
Dim lProcType As Long
Dim lProcTypePrevious As Long
Dim lModules As Long
Dim lModuleCount As Long
Dim lModuleLineCount As Long
Dim collModules As Collection
Dim collModulesType As Collection
Dim collProcNames As Collection
Dim collProcTypes As Collection
Dim collProcStartLine As Collection
Dim collProcLineCount As Collection
Dim strWBType As String
Dim arrResult

10 If UCase(Right$(VBProj.Filename, 3)) = "XLA" Then
20 strWBType = "add-in"
30 Else
40 strWBType = "workbook"
50 End If

60 On Error Resume Next
70 lModules = VBProj.VBComponents.Count

80 If Err.Number = 50289 Then
90 MsgBox "Can't document this " & strWBType & _
" as it is protected", , VBProj.Filename
100 Exit Function
110 End If

120 On Error GoTo ERROROUT

130 strStatusIndent = " "

140 Set collModules = New Collection
150 Set collModulesType = New Collection
160 Set collProcNames = New Collection
170 Set collProcTypes = New Collection
180 Set collProcStartLine = New Collection
190 Set collProcLineCount = New Collection

200 For Each VBComp In VBProj.VBComponents

210 Application.StatusBar = strStatusIndent & "doing module " &
VBComp.Name

220 DoEvents
230 lModuleCount = lModuleCount + 1
240 DoEvents

250 With VBComp.CodeModule

'if we don't start past the declarations it will crash as it is
now

'------------------------------------------------------------------
260 lCodeLine = .CountOfDeclarationLines

270 Do Until lCodeLine = .CountOfLines

280 lCodeLine = lCodeLine + 1

290 strProcName = .ProcOfLine(lCodeLine, lProcType)

'we have to catch Property procedures that have the same name
'------------------------------------------------------------
300 If strProcName < strProcNamePrevious Or _
lProcType < lProcTypePrevious Then

310 strProcNamePrevious = strProcName
320 lProcTypePrevious = lProcType
330 lProcBodyLine = .ProcBodyLine(strProcName, lProcType)
340 lProcLineCount = .ProcCountLines(strProcName, lProcType)

350 If lProcType = 0 Then
'Sub or Function, unfortunately ProcType can't differentiate
these

'-----------------------------------------------------------------

'find the real end of the procedure
'comments at the end belong to the procedure!
'note that this will fail without the len bit
'--------------------------------------------
360 Do While Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))) = 0 Or _
(.Find("End Sub", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = False And _
.Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine +
lProcLineCount -
x, 1))), _
True, True) = False)
370 x = x + 1
380 Loop

'see if we have a function or a sub
'this is not foolproof as there could be comments on that
line
'could limit the EndColumn by looking for a ' first, but not
'worth the extra overhead

'-------------------------------------------------------------
390 If .Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount - x,
1))), _
True, True) = True Then
'Function
'--------
400 strProcType = "Function"
410 Else
'Sub
'---
420 strProcType = "Sub"
430 End If

440 x = 0

450 Else 'If lProcType = 0
'Property procedure
'------------------
460 Select Case lProcType
Case 1 'Property Set
470 strProcType = "Property Set"
480 Case 2 'Property Let
490 strProcType = "Property Let"
500 Case 3 'Property Get
510 strProcType = "Property Get"
520 End Select
530 End If 'If lProcType = 0

540 collModules.Add VBComp.Name
550 collModulesType.Add CompTypeToName(VBComp)
560 collProcNames.Add strProcName
570 collProcTypes.Add strProcType
580 collProcStartLine.Add lProcBodyLine
590 collProcLineCount.Add lProcLineCount

600 End If
610 Loop

620 End With
630 Next VBComp

640 Application.StatusBar = strStatusIndent & _
"putting the data in the result array"

650 ReDim arrResult(1 To collProcNames.Count, 1 To 6)

660 For i = 1 To collProcNames.Count
670 arrResult(i, 1) = collModules(i)
680 arrResult(i, 2) = collModulesType(i)
690 arrResult(i, 3) = collProcNames(i)
700 arrResult(i, 4) = collProcTypes(i)
710 arrResult(i, 5) = collProcStartLine(i)
720 arrResult(i, 6) = collProcLineCount(i)
730 Next i

740 Application.StatusBar = False

750 GetProcedures = arrResult

760 Exit Function
ERROROUT:

770 Application.StatusBar = False

780 If Err.Number = 9 Then
790 MsgBox VBProj.Filename & " is not open!", , "workbook stats"
800 Else
810 MsgBox Err.Description & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & _
"Error line: " & Erl, , "workbook stats"
820 End If

End Function


Function CompTypeToName(VBComp As VBComponent) As String

Select Case VBComp.Type
Case vbext_ct_ActiveXDesigner
CompTypeToName = "ActiveX Designer"
Case vbext_ct_ClassModule
CompTypeToName = "Class Module"
Case vbext_ct_Document
CompTypeToName = "Document"
Case vbext_ct_MSForm
CompTypeToName = "MS Form"
Case vbext_ct_StdModule
CompTypeToName = "Standard Module"
Case Else
End Select

End Function


RBS


"RB Smissaert" wrote in message
...
This code will remove comments, indentations and blank lines. It will
need
a reference to the VBE extensiblity,
Microsoft Visual Basic for Applications Extensibility 5.x. You could
put
it in an add-in.

Option Explicit
Private VBProjToClean As VBProject
Private strFileToClean As String

Sub CompactVBEProject()

Dim VBC As VBComponent
Dim WB As Workbook
Dim VBProj As VBProject
Dim strFile As String
Dim msgResult As VbMsgBoxResult

For Each VBProj In Application.VBE.VBProjects
On Error Resume Next
Select Case MsgBox("Compact this file?", _
vbYesNoCancel + vbDefaultButton2, _
VBProj.Filename)
Case vbYes
Set VBProjToClean = VBProj
strFileToClean = VBProj.Filename
Exit For
Case vbNo
Case vbCancel
Exit Sub
End Select
Next

If VBProjToClean Is Nothing Then
Exit Sub