How to distribute addin with a reference library checked?

[Caroline]

Hi,

I have created an addin for group people, which need Microsfot Visual basic
for application extensibility 5.3 be checked. I have done this in my addin
file. But when rest of group people got it and installed, some machines won't
keep this reference checked. Can I solve this issue in my addin file, so
other people won't need do anything?

 

[RB Smissaert]

Simplest way to handle this problem is late binding, so in that case no
reference to the application extensibility is needed.

As an example:

Sub ListExcelReferences()

'to list all the references in Excel
'-----------------------------------
Dim i As Long
Dim n As Long
Dim lRefCount As Long
Dim VBProj As Object 'late binding

Cells.Clear

Cells(1).Value = "Project name"
Cells(2).Value = "Project file"
Cells(3).Value = "Reference Name"
Cells(4).Value = "Description"
Cells(5).Value = "FullPath"
Cells(6).Value = "GUID"
Cells(7).Value = "Major"
Cells(8).Value = "Minor"

On Error Resume Next 'as an un-saved workbook has no filename yet

For Each VBProj In Application.VBE.VBProjects
n = n + 1
With VBProj
lRefCount = .References.Count
With .References
For i = 1 To lRefCount
n = n + 1
If i = 1 Then
Cells(n, 1).Value = VBProj.Name
Cells(n, 2).Value = VBProj.Filename
If Err.Number = 76 Then 'Path not found
Cells(n, 2).Value = "Project not saved yet"
Err.Clear
End If
End If
Cells(n, 3).Value = .Item(i).Name
Cells(n, 4).Value = .Item(i).Description
Cells(n, 5).Value = .Item(i).FullPath
Cells(n, 6).Value = .Item(i).GUID
Cells(n, 7).Value = .Item(i).Major
Cells(n, 8).Value = .Item(i).Minor
Next i
End With
End With
Next VBProj

Range(Cells(1), Cells(8)).Font.Bold = True
Range(Cells(1), Cells(n, 8)).Columns.AutoFit

End Sub


This will run fine with no reference set.


RBS

 

[Jim Thomlinson]

Uncheck the reference. You probably don't need it... Check out this link for
a full discussion...

http://www.microsoft.com/communitie...&pt=&catlist=&dglist=&ptlist=&exp=&sloc=en-us

 

[Caroline]

Thank you so much for your replies, Jim & RB.

I need count macros in Excel which is using VBE object. That needs
extensibility reference. Some machines got compiling error when running my
addin. I do need keep this reference checked. Am I right?

 

[RB Smissaert]

I am nearly sure it can be done without the reference.
Post the code you got now and somebody will change it to work
without the reference.

RBS

 

[Caroline]

Jim, Thank you so much. After carefully work through the link you give me, I
solve the reference problem. Change all VB constants to
intrinsic values. That works. Thank you so much again.

 

[Caroline]

Thank you so much, RB. I found here is really good. I can get lots help.

 

[RB Smissaert]

I can see you got this fixed now, but here code that fully documents a
project, including counting the macros,
all without a reference to the VBE extensibility:

Option Explicit
Option Private Module
Private Declare Function GetTempPathA _
Lib "kernel32" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private strExportFolder As String
Private Enum vbComponentType
StandardModule = 1
ClassModule = 2
MSForm = 3
ActiveXDesigner = 11
Document = 100
End Enum
Private Enum vbProcedureType
Procedure = 0
ProcLet = 1
ProcSet = 2
ProcGet = 3
End Enum

Function GetExportFolder() As String

Dim lReturn As Long
Dim strBuffer As String
Dim strTemp As String

'get the temp folder
'-------------------
strBuffer = String$(260, vbNullChar)
lReturn = GetTempPathA(260, strBuffer)

If lReturn = 0 Then
strTemp = FolderFromPathVBA(ThisWorkbook.Path)
Else
strTemp = Left$(strBuffer, lReturn)
End If

If Right$(strTemp, 1) <> "\" Then
strTemp = strTemp & "\"
End If

GetExportFolder = strTemp

End Function

Function GetModuleSize(oComp As Object) As Double

Dim lTempSize As Long
Dim strFile As String

On Error Resume Next

Select Case CompTypeToName(oComp)
Case "Class Module", "Document"
strFile = strExportFolder & oComp.Name & ".cls"
oComp.Export strFile
lTempSize = FileLen(strFile)
If lTempSize < 235 Then
lTempSize = 0
End If
Kill strFile
Case "MS Form"
strFile = strExportFolder & oComp.Name & ".frm"
oComp.Export strFile
lTempSize = FileLen(strFile)
If lTempSize < 235 Then
lTempSize = 0
End If
Kill strFile
Kill strExportFolder & oComp.Name & ".frx"
Case "Standard Module"
strFile = strExportFolder & oComp.Name & ".bas"
oComp.Export strFile
lTempSize = FileLen(strFile)
If lTempSize < 31 Then
lTempSize = 0
End If
Kill strFile
End Select

GetModuleSize = Round(lTempSize / 1024, 1)

End Function

Function CompTypeToName(VBComp As Object) As String

Select Case VBComp.Type
Case vbComponentType.ActiveXDesigner 'vbext_ct_ActiveXDesigner = 11
CompTypeToName = "ActiveX Designer"
Case vbComponentType.ClassModule 'vbext_ct_ClassModule = 2
CompTypeToName = "Class Module"
Case vbComponentType.Document 'vbext_ct_Document = 100
CompTypeToName = "Document"
Case vbComponentType.MSForm 'vbext_ct_MSForm = 3
CompTypeToName = "MS Form"
Case vbComponentType.StandardModule 'vbext_ct_StdModule = 1
CompTypeToName = "Standard Module"
Case Else
End Select

End Function

Sub ThinRightBorderz(rng As Range)
With rng
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub

Sub ThinBottomBorderz(rng As Range)
With rng
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
End Sub

Sub MediumBottomBorderz(rng As Range)
With rng
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End Sub

Sub MediumRightBorderz(rng As Range)
With rng
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With
End Sub

Function FileFromPathVBA(ByVal strFullPath As String, _
Optional bExtensionOff As Boolean = False) As
String

Dim FPL As Long 'len of full path
Dim PLS As Long 'position of last slash
Dim pd As Long 'position of dot before exension
Dim strFile As String

On Error GoTo ERROROUT

FPL = Len(strFullPath)
PLS = InStrRev(strFullPath, "\", , vbBinaryCompare)
strFile = Right$(strFullPath, FPL - PLS)

If bExtensionOff = False Then
FileFromPathVBA = strFile
Else
pd = InStr(1, strFile, ".", vbBinaryCompare)
FileFromPathVBA = Left$(strFile, pd - 1)
End If

Exit Function
ERROROUT:

End Function

Function FolderFromPathVBA(strFullPath As String) As String

Dim PLS As Byte 'position of last slash

On Error GoTo ERROROUT

PLS = InStrRev(strFullPath, "\", , vbBinaryCompare)

If PLS = 3 Then
FolderFromPathVBA = Left$(strFullPath, PLS)
Else
FolderFromPathVBA = Left$(strFullPath, PLS - 1)
End If

Exit Function
ERROROUT:

End Function

Sub GoToVBELinez()

GoToVBELine2z

End Sub

Sub GoToVBELine2z(Optional strProject As String, _
Optional strModule As String, _
Optional strProcedure, _
Optional bFunction As Boolean = False, _
Optional lErl As Long = -1)

Dim strCell As String
Dim lBracketPos As Long
Dim lSpacePos As Long
Dim lStartLine As Long
Dim lProcedureLine As Long
Dim strSelection As String
Dim i As Long

On Error GoTo ERROROUT

If Len(strProject) = 0 Then
strProject = ActiveSheet.Name
End If

If Len(strModule) = 0 Then
strModule = Cells(ActiveCell.Column).Value
End If

If lErl = -1 Then
'get there from values in the sheet
'----------------------------------
strCell = ActiveCell.Value
lBracketPos = InStr(1, strCell, "(", vbBinaryCompare)
lSpacePos = InStr(lBracketPos, strCell, Chr(32), vbBinaryCompare)
lStartLine = Val(Mid$(strCell, lBracketPos + 1, lSpacePos - (lBracketPos
+ 1)))
With
Workbooks(strProject).VBProject.VBComponents(strModule).CodeModule.CodePane
.SetSelection lStartLine, 1, lStartLine, 1
.Show
End With
Else
'get there from values from an error handler
'-------------------------------------------
With Workbooks(strProject).VBProject.VBComponents(strModule).CodeModule
lProcedureLine = .ProcStartLine(strProcedure,
vbProcedureType.Procedure)
Do While .Find(CStr(lErl), _
lProcedureLine + i, _
1, _
lProcedureLine + i, _
Len(CStr(Erl)) + 1, _
True, _
False) = False
i = i + 1
Loop
With .CodePane
.SetSelection lProcedureLine + i, 1, lProcedureLine + i, 1
.Show
End With
End With
End If

Exit Sub
ERROROUT:

If Err.Number = 5 Then
MsgBox "You are not in a cell holding a procedure", , "go to procedure
in VBE"
Exit Sub
End If

MsgBox Err.Description & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & _
"Error line: " & Erl, , "go to procedure in VBE"

End Sub

Sub test()

DocumentProject True, "AddinABC.xla", True, True

End Sub

Sub DocumentProject(bProcedures As Boolean, _
strWorkbook As String, _
bSortProcs As Boolean, _
bClearTrailingBlanks As Boolean)

Dim strTempDir As String
Dim strStatusIndent As String
Dim sh As Worksheet

Dim VBProj As Object
Dim VBComp As Object
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 i As Long
Dim n As Long
Dim x As Long

Dim dFileSize As Double
Dim lModules As Long
Dim lModuleCount As Long
Dim lProcedureCount As Long
Dim lMaxProcCount As Long
Dim lSubCount As Long
Dim lFunctionCount As Long
Dim lPropertyGetCount As Long
Dim lPropertyLetCount As Long
Dim lPropertySetCount As Long

Dim lSubLineCount As Long
Dim lFunctionLineCount As Long
Dim lPropertyGetLineCount As Long
Dim lPropertyLetLineCount As Long
Dim lPropertySetLineCount As Long
Dim lNonBlankLineCount As Long
Dim lTrailingBlankLines As Long

Dim lModuleLineCount As Long
Dim lDeclarationLineCount As Long
Dim lCommentLineCount As Long
Dim lBlankLineCount As Long

Dim lTotalProcedures As Long
Dim lTotalSubs As Long
Dim lTotalFunctions As Long
Dim lTotalPropertySet As Long
Dim lTotalPropertyLet As Long
Dim lTotalPropertyGet As Long
Dim lTotalNonBlankLineCount As Long
Dim lTotalTrailingBlankLines As Long

Dim dTotalFileSize As Double
Dim lAllTotalLines As Long
Dim lTotalDeclLines As Long
Dim lTotalBlankLines As Long
Dim lTotalCommentLines As Long

Dim lTotalSubLines As Long
Dim lTotalFunctionLines As Long
Dim lTotalPropertySetLines As Long
Dim lTotalPropertyLetLines As Long
Dim lTotalPropertyGetLines As Long

Dim bStringMode As Boolean
Dim bLineContinue As Boolean
Dim str As String
Dim LR As Long
Dim LC As Long
Dim collProcs As Collection
Dim collLines As Collection
Dim arr
Dim lLastNonBlankLine As Long
Dim strWBType As String

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

60 On Error Resume Next

70 lModules = Workbooks(strWorkbook).VBProject.VBComponents.Count

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

120 On Error GoTo ERROROUT

130 strTempDir = CurDir

140 If Len(strWorkbook) = 0 Then
150 ChDir strTempDir
160 Exit Sub
170 End If

180 strStatusIndent = " "

190 strExportFolder = GetExportFolder()

200 Application.ScreenUpdating = False

210 For Each sh In ActiveWorkbook.Worksheets
220 If sh.Name = "Project_Stats" Then
230 sh.Activate
240 Exit For
250 End If
260 Next

270 Cells.Clear

280 Cells(1) = "Module"
290 Cells(2) = "Total"
300 Cells(2, 1) = "Module Count - Type"

310 Cells(3, 1) = "Procedures"
320 Cells(4, 1) = "Subs"
330 Cells(5, 1) = "Functions"
340 Cells(6, 1) = "Property Set"
350 Cells(7, 1) = "Property Let"
360 Cells(8, 1) = "Property Get"

370 Cells(9, 1) = "File size Kb >"
380 Cells(10, 1) = "Total lines"
390 Cells(11, 1) = "Decl. lines"
400 Cells(12, 1) = "Blank lines"
410 Cells(13, 1) = "Comment lines"

420 Cells(14, 1) = "Sub lines"
430 Cells(15, 1) = "Function lines"
440 Cells(16, 1) = "Property Set lines"
450 Cells(17, 1) = "Property Let lines"
460 Cells(18, 1) = "Property Get lines"
470 Cells(19, 1) = "Trailing blank lines"

480 If bProcedures Then
490 Cells(20, 1) = "Procs, starting line - line count"
500 End If

510 For Each VBComp In Workbooks(strWorkbook).VBProject.VBComponents

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

530 DoEvents

540 If bProcedures Then
550 Set collProcs = New Collection
560 Set collLines = New Collection
570 End If

580 lProcedureCount = 0
590 lSubCount = 0
600 lFunctionCount = 0
610 lPropertyGetCount = 0
620 lPropertyLetCount = 0
630 lPropertySetCount = 0
640 lCommentLineCount = 0
650 lBlankLineCount = 0
660 lFunctionLineCount = 0
670 lSubLineCount = 0
680 lPropertySetLineCount = 0
690 lPropertyLetLineCount = 0
700 lPropertyGetLineCount = 0
710 lLastNonBlankLine = 0
720 lTrailingBlankLines = 0

730 lModuleCount = lModuleCount + 1
740 DoEvents

750 With VBComp.CodeModule

'count blank lines, run here to include the declaration lines
'------------------------------------------------------------
760 For i = 1 To .CountOfLines
770 If Len(Trim(.Lines(i, 1))) = 0 Then
780 lBlankLineCount = lBlankLineCount + 1
790 Else
800 lLastNonBlankLine = i
810 lNonBlankLineCount = lNonBlankLineCount + 1
820 End If
830 Next

840 If bClearTrailingBlanks Then
850 If .CountOfLines > lLastNonBlankLine Then
860 For i = .CountOfLines To lLastNonBlankLine + 1 Step -1
870 .DeleteLines i
880 Next
890 End If
900 lTrailingBlankLines = 0
910 Else
920 lTrailingBlankLines = .CountOfLines - lLastNonBlankLine
930 End If

'count comment lines
'-------------------
940 bStringMode = False
950 i = 1

960 Do Until i > .CountOfLines

970 str = .Lines(i, 1)
980 bLineContinue = (Right(str, 2) = " _")

990 For n = 1 To Len(str)
1000 Select Case Mid(str, n, 1)
Case """"
1010 bStringMode = Not bStringMode
1020 Case "'"
1030 If Not bStringMode Then
1040 str = RTrim(Mid(str, 1, n - 1))
1050 If LTrim(str) = "" Then
1060 lCommentLineCount = lCommentLineCount + 1
1070 End If

1080 Do While bLineContinue
1090 bLineContinue = _
(Right$(.Lines(i + 1, 1), 2) = " _")
1100 lCommentLineCount = lCommentLineCount + 1
1110 i = i + 1
1120 Loop
1130 Exit For
1140 End If
1150 End Select
1160 Next

1170 i = i + 1
1180 Loop

'if we don't start past the declarations it will crash as it is
now
'------------------------------------------------------------------
1190 lCodeLine = .CountOfDeclarationLines

1200 Do Until lCodeLine = .CountOfLines

1210 lCodeLine = lCodeLine + 1

1220 strProcName = .ProcOfLine(lCodeLine, lProcType)

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

1240 lProcedureCount = lProcedureCount + 1

1250 If lProcedureCount > lMaxProcCount Then
1260 lMaxProcCount = lProcedureCount
1270 End If

1280 strProcNamePrevious = strProcName
1290 lProcTypePrevious = lProcType
1300 lProcBodyLine = .ProcBodyLine(strProcName, lProcType)
1310 lProcLineCount = .ProcCountLines(strProcName, lProcType)

1320 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
'--------------------------------------------
1330 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)
1340 x = x + 1
1350 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
'-------------------------------------------------------------
1360 If .Find("End Function", _
lProcBodyLine + lProcLineCount - x, _
1, _
lProcBodyLine + lProcLineCount - x, _
Len(Trim(.Lines(lProcBodyLine + lProcLineCount -
x, 1))), _
True, True) = True Then
'Function
'--------
1370 lFunctionCount = lFunctionCount + 1
1380 lFunctionLineCount = lFunctionLineCount + lProcLineCount
1390 strProcType = "Function "

1400 Else
'Sub
'---
1410 lSubCount = lSubCount + 1
1420 lSubLineCount = lSubLineCount + lProcLineCount
1430 strProcType = "Sub "
1440 End If

1450 x = 0

1460 Else 'If lProcType = 0
'Property procedure
'------------------
1470 Select Case lProcType
Case 1 'Property Set
1480 lPropertySetCount = lPropertySetCount + 1
1490 lPropertySetLineCount = lPropertySetLineCount +
lProcLineCount
1500 strProcType = "Property Set "
1510 Case 2 'Property Let
1520 lPropertyLetCount = lPropertyLetCount + 1
1530 lPropertyLetLineCount = lPropertyLetLineCount +
lProcLineCount
1540 strProcType = "Property Let "
1550 Case 3 'Property Get
1560 lPropertyGetCount = lPropertyGetCount + 1
1570 lPropertyGetLineCount = lPropertyGetLineCount +
lProcLineCount
1580 strProcType = "Property Get "
1590 End Select
1600 End If 'If lProcType = 0

1610 If bProcedures Then
1620 collProcs.Add strProcType & strProcName & _
" (" & lProcBodyLine & " - " & _
lProcLineCount & ")"
1630 collLines.Add lProcLineCount
1640 End If

1650 End If
1660 Loop

1670 If bProcedures Then
1680 If collProcs.Count > 0 Then
'dump collection in sheet
'------------------------
1690 ReDim arr(1 To collProcs.Count, 1 To 2)

1700 For i = 1 To collProcs.Count
1710 arr(i, 1) = collProcs(i)
1720 arr(i, 2) = collLines(i)
1730 Next

'sort descending on linecount
'----------------------------
1740 With Range(Cells(21, 2 + lModuleCount), _
Cells(UBound(arr) + 20, 3 + lModuleCount))
1750 .Value = arr
1760 If bSortProcs And UBound(arr) > 1 Then
1770 .Sort Key1:=Cells(21, 3 + lModuleCount), _
Order1:=xlDescending, _
Header:=xlNo, _
Orientation:=xlTopToBottom
1780 End If
1790 .Select
1800 End With

'clear the line counts
'---------------------
1810 Range(Cells(21, 3 + lModuleCount), _
Cells(UBound(arr) + 20, 3 + lModuleCount)).Clear
1820 End If
1830 End If

'finished with this module so add module stats
'---------------------------------------------
1840 lModuleLineCount = .CountOfLines
1850 lDeclarationLineCount = .CountOfDeclarationLines
1860 dFileSize = GetModuleSize(VBComp)

1870 lTotalProcedures = lTotalProcedures + lProcedureCount
1880 lTotalSubs = lTotalSubs + lSubCount
1890 lTotalFunctions = lTotalFunctions + lFunctionCount
1900 lTotalPropertySet = lTotalPropertySet + lPropertySetCount
1910 lTotalPropertyLet = lTotalPropertyLet + lPropertyLetCount
1920 lTotalPropertyGet = lTotalPropertyGet + lPropertyGetCount

1930 dTotalFileSize = dTotalFileSize + dFileSize
1940 lAllTotalLines = lAllTotalLines + lModuleLineCount
1950 lTotalDeclLines = lTotalDeclLines + lDeclarationLineCount
1960 lTotalBlankLines = lTotalBlankLines + lBlankLineCount
1970 lTotalCommentLines = lTotalCommentLines + lCommentLineCount
1980 lTotalSubLines = lTotalSubLines + lSubLineCount
1990 lTotalFunctionLines = lTotalFunctionLines + lFunctionLineCount
2000 lTotalPropertySetLines = lTotalPropertySetLines +
lPropertySetLineCount
2010 lTotalPropertyLetLines = lTotalPropertyLetLines +
lPropertyLetLineCount
2020 lTotalPropertyGetLines = lTotalPropertyGetLines +
lPropertyGetLineCount
2030 lTotalTrailingBlankLines = lTotalTrailingBlankLines +
lTrailingBlankLines

'module name
'-----------
2040 Cells(2 + lModuleCount) = VBComp.Name

2050 If bProcedures Then
2060 Cells(20, 2 + lModuleCount) = VBComp.Name
2070 End If

'module type
'-----------
2080 Cells(2, 2 + lModuleCount) = CompTypeToName(VBComp)

'number of procedures
'--------------------
2090 Cells(3, 2 + lModuleCount) = lProcedureCount
2100 Cells(4, 2 + lModuleCount) = lSubCount
2110 Cells(5, 2 + lModuleCount) = lFunctionCount
2120 Cells(6, 2 + lModuleCount) = lPropertySetCount
2130 Cells(7, 2 + lModuleCount) = lPropertyLetCount
2140 Cells(8, 2 + lModuleCount) = lPropertyGetCount

'exported file size
'------------------
2150 Cells(9, 2 + lModuleCount) = dFileSize

'line counts
'----------
2160 Cells(10, 2 + lModuleCount) = lModuleLineCount
2170 Cells(11, 2 + lModuleCount) = lDeclarationLineCount
2180 Cells(12, 2 + lModuleCount) = lBlankLineCount
2190 Cells(13, 2 + lModuleCount) = lCommentLineCount

2200 Cells(14, 2 + lModuleCount) = lSubLineCount
2210 Cells(15, 2 + lModuleCount) = lFunctionLineCount
2220 Cells(16, 2 + lModuleCount) = lPropertySetLineCount
2230 Cells(17, 2 + lModuleCount) = lPropertyLetLineCount
2240 Cells(18, 2 + lModuleCount) = lPropertyGetLineCount
2250 Cells(19, 2 + lModuleCount) = lTrailingBlankLines

2260 End With
2270 Next VBComp

2280 If bProcedures Then
2290 LR = 20 + lMaxProcCount
2300 Else
2310 LR = 19
2320 End If

2330 LC = 2 + lModuleCount

2340 Application.StatusBar = False

'totalnumber of procedures
'-------------------------
2350 Cells(2, 2) = lModuleCount
2360 Cells(3, 2) = lTotalProcedures
2370 Cells(4, 2) = lTotalSubs
2380 Cells(5, 2) = lTotalFunctions
2390 Cells(6, 2) = lTotalPropertySet
2400 Cells(7, 2) = lTotalPropertyLet
2410 Cells(8, 2) = lTotalPropertyGet

'total exported file size
'------------------------
2420 Cells(9, 2) = dTotalFileSize

'total line counts
'-----------------
2430 Cells(10, 2) = lAllTotalLines
2440 Cells(11, 2) = lTotalDeclLines
2450 Cells(12, 2) = lTotalBlankLines
2460 Cells(13, 2) = lTotalCommentLines

2470 Cells(14, 2) = lTotalSubLines
2480 Cells(15, 2) = lTotalFunctionLines
2490 Cells(16, 2) = lTotalPropertySetLines
2500 Cells(17, 2) = lTotalPropertyLetLines
2510 Cells(18, 2) = lTotalPropertyGetLines
2520 Cells(19, 2) = lTotalTrailingBlankLines

2530 Range(Cells(3), Cells(LR, LC)).Sort Key1:=Range("C9"), _
Order1:=xlDescending, _
Header:=xlNo, _
Orientation:=xlLeftToRight

2540 If bProcedures Then
2550 For i = 1 To lMaxProcCount
2560 Cells(20 + i, 1) = i
2570 Next
2580 End If

2590 Range(Cells(1), Cells(LR, 1)).Interior.ColorIndex = 20

2600 With Range(Cells(1), Cells(LC))
2610 .Font.Bold = True
2620 .HorizontalAlignment = xlLeft
2630 .Interior.ColorIndex = 20
2640 End With

2650 Range(Cells(1), Cells(LR, 1)).Font.Bold = True

2660 If bProcedures Then
2670 Range(Cells(20, 3), Cells(20, LC)).Font.Bold = True
2680 MediumRightBorderz Range(Cells(21, 1), Cells(LR, 1))
2690 End If

2700 MediumBottomBorderz Range(Cells(1), Cells(LC))
2710 MediumRightBorderz Range(Cells(1), Cells(19, 1))

2720 MediumBottomBorderz Range(Cells(LR, 1), Cells(LR, LC))
2730 MediumRightBorderz Range(Cells(LC), Cells(LR, LC))
2740 MediumRightBorderz Range(Cells(2), Cells(19, 2))
2750 ThinBottomBorderz Range(Cells(8, 1), Cells(8, LC))
2760 ThinBottomBorderz Range(Cells(9, 1), Cells(9, LC))

2770 For n = 3 To LC
2780 If n Mod 2 = 1 Then
2790 Range(Cells(2, n), Cells(LR, n)).Interior.ColorIndex = 19
2800 End If
2810 Next

2820 If bProcedures Then
2830 Range(Cells(20, 1), Cells(20, LC)).Interior.ColorIndex = 20
2840 MediumBottomBorderz Range(Cells(19, 1), Cells(19, LC))
2850 MediumBottomBorderz Range(Cells(20, 1), Cells(20, LC))
2860 End If

2870 Range(Cells(1), Cells(LC)).Font.Bold = True
2880 Range(Cells(2), Cells(LR, LC)).Columns.AutoFit
2890 Range(Cells(1), Cells(19, 1)).Columns.AutoFit

2900 With Range(Cells(1), Cells(LR, LC))
2910 .HorizontalAlignment = xlLeft
2920 .Name = "Project_Stats"
2930 End With

2940 If bProcedures Then
2950 Columns(2).ColumnWidth = 10
2960 End If

2970 ActiveSheet.Name = strWorkbook
2980 Application.ScreenUpdating = True
2990 ChDir strTempDir

3000 Exit Sub
ERROROUT:

3010 Application.StatusBar = False
3020 Application.ScreenUpdating = False
3030 ChDir strTempDir

3040 If Err.Number = 9 Then
3050 MsgBox strWorkbook & " is not open!", , "workbook stats"
3060 Else
3070 MsgBox Err.Description & vbCrLf & _
"Error number: " & Err.Number & vbCrLf & _
"Error line: " & Erl, , "workbook stats"
3080 End If

End Sub


RBS