List of macros error #35

[AC PORTA VIA]

Below code errors out on this line- not sure why

StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)

Sub ListMacrosssss()
Const vbext_pk_Proc = 0
Dim VBComp As Object
Dim VBCodeMod As Object
Dim oListsheet As Object
Dim StartLine As Long
Dim iCount As Integer

Application.ScreenUpdating = False

Set oListsheet = ActiveWorkbook.Worksheets.Add
iCount = 1
oListsheet.Range("A1").value = "=COUNTA(R[1]C:R[999]C)&"" - ""&""MACROS"""

For Each VBComp In ThisWorkbook.VBProject.VBComponents
Set VBCodeMod = _
ThisWorkbook.VBProject.VBComponents(VBComp.Name).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
oListsheet.[A1].Offset(iCount, 0).value = VBCodeMod & "_" & .ProcOfLine(StartLine, vbext_pk_Proc)
iCount = iCount + 1
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
Set VBCodeMod = Nothing
Next VBComp

Application.ScreenUpdating = True


End Sub

 

[AC PORTA VIA]

and error ( I forgot to include ) "Sub or Function not defined."

 

[MARK858]

The code runs fine for me, what do you have checked under Tools - References? and do you have the code in a regular module?

 

[AC PORTA VIA]

Thanks Mark858,
Yes macro is in regular module- macro runs displays must of the macros and then errors out.
I made new workbook with less macros and macro runs fine also.
I am not sure but could issue be with one of the macros that have to many lines in the code itself?

 

[Alex Blakenburg]

I am not sure but could issue be with one of the macros that have to many lines in the code itself?

Does it make any difference if you Dim iCount as Long ?

 

[AC PORTA VIA]

Does it make any difference if you Dim iCount as Long ?

No it does not, same thing happen.
thanks

 

[MARK858]

Can you add the lines in red below, and...
If a macro name appears in the Immediate Window post the macro in the thread
If it errors on the Debug.Print line post the error and also hover your mouse over StartLine , then post what value you see

        With VBCodeMod
            StartLine = .CountOfDeclarationLines + 1
            Do Until StartLine >= .CountOfLines
                oListsheet.[A1].Offset(iCount, 0).Value = VBCodeMod & "_" & .ProcOfLine(StartLine, vbext_pk_Proc)
                iCount = iCount + 1
             
                On Error GoTo myerror:
             
                StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
            Loop
myerror:
    Debug.Print .ProcOfLine(StartLine, vbext_pk_Proc)
        End With

        Set VBCodeMod = Nothing
    Next VBComp

 

[AC PORTA VIA]

Can you add the lines in red below, and...
If a macro name appears in the Immediate Window post the macro in the thread
If it errors on the Debug.Print line post the error and also hover your mouse over StartLine , then post what value you see

        With VBCodeMod
            StartLine = .CountOfDeclarationLines + 1
            Do Until StartLine >= .CountOfLines
                oListsheet.[A1].Offset(iCount, 0).Value = VBCodeMod & "_" & .ProcOfLine(StartLine, vbext_pk_Proc)
                iCount = iCount + 1
           
                On Error GoTo myerror:
           
                StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, vbext_pk_Proc), vbext_pk_Proc)
            Loop
myerror:
    Debug.Print .ProcOfLine(StartLine, vbext_pk_Proc)
        End With

        Set VBCodeMod = Nothing
    Next VBComp

I was able to narrow it down to macro that creates this error- it is one of the class modules macros and when I added line of code to skip that macro, I didn't have error anymore and MACRO finishes with no problem displaying couple more macros that I couldn't get it at first.

I just tried to add line of code from you to see will it display same macro that I found with issue, but it doesn't display macro name or error, macro finishes with no problem displaying couple more macros that I couldn't get it at first with same total # of macros.
I will mark your post #7 as solution.

 

[AC PORTA VIA]

here is the Class Module macro that errors out

Option Explicit

' API declarations
#If VBA7 And Win64 Then
    Private Declare PtrSafe Function GetVersionEx Lib "Kernel32" _
        Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long

    Private Declare PtrSafe Sub keybd_event Lib "user32" _
        (ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwflags As Long, ByVal dwExtraInfo As Long)

    Private Declare PtrSafe Function GetKeyboardState Lib "user32" _
        (pbKeyState As Byte) As Long

    Private Declare PtrSafe Function SetKeyboardState Lib "user32" _
        (lppbKeyState As Byte) As Long
#Else
    Private Declare Function GetVersionEx Lib "Kernel32" _
        Alias "GetVersionExA" _
        (lpVersionInformation As OSVERSIONINFO) As Long

    Private Declare Sub keybd_event Lib "user32" _
        (ByVal bVk As Byte, _
        ByVal bScan As Byte, _
        ByVal dwflags As Long, ByVal dwExtraInfo As Long)

    Private Declare Function GetKeyboardState Lib "user32" _
        (pbKeyState As Byte) As Long

    Private Declare Function SetKeyboardState Lib "user32" _
        (lppbKeyState As Byte) As Long
#End If

' Type declaration
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type


'Constant declarations
Const VK_NUMLOCK = &H90
Const VK_SCROLL = &H91
Const VK_CAPITAL = &H14
Const KEYEVENTF_EXTENDEDKEY = &H1
Const KEYEVENTF_KEYUP = &H2

Property Get value() As Boolean
'   Get the current state
    Dim keys(0 To 255) As Byte
    GetKeyboardState keys(0)
    value = keys(VK_NUMLOCK)
End Property

Property Let value(boolVal As Boolean)
    Dim o As OSVERSIONINFO
    Dim keys(0 To 255) As Byte
    o.dwOSVersionInfoSize = Len(o)
    GetVersionEx o
    GetKeyboardState keys(0)
'   Is it already in that state?
    If boolVal = True And keys(VK_NUMLOCK) = 1 Then Exit Property
    If boolVal = False And keys(VK_NUMLOCK) = 0 Then Exit Property
'   Toggle it
    'Simulate Key Press
    keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
    'Simulate Key Release
    keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
      KEYEVENTF_KEYUP, 0
End Property

Sub Toggle()
'   Toggles the state
    Dim o As OSVERSIONINFO
    o.dwOSVersionInfoSize = Len(o)
    GetVersionEx o
    Dim keys(0 To 255) As Byte
    GetKeyboardState keys(0)
    'Simulate Key Press
    keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or 0, 0
    'Simulate Key Release
    keybd_event VK_NUMLOCK, &H45, KEYEVENTF_EXTENDEDKEY Or _
      KEYEVENTF_KEYUP, 0
End Sub

 

[MARK858]

Happy you have a workaround, I won't be able to test if there is an issue in the code as I don't have a Numlock on my laptop.

Btw, I would mark post 8 as the solution as my post might have given you a nudge but you found the issue yourself