How to make a list of all modules and subs but also with all the subs - Microsoft Community

with following code not only want create list of modules , subs in active workbook find of subs called on in subs.

the main part ok jest last part can't seem wright:

if vbcomp.find(strfindcall, istart, 1, iend, 1, false, false) = true then

strfindcall, istart , iend filled correct data using 3 of these variables not work. when replace istart , iend numbers ok, don't want that.

can please?

frank

sub listmacros()
'make list of macros in active workbook in new worksheet

const vbext_pk_proc = 0
dim vbcomp object
dim vbcodemod object
dim olistsheet object
dim startline long
dim procname string
dim icount integer
dim intcountlines integer
dim strtemp string
dim x

application.cursor = xlwait
application.screenupdating = false
application.displayalerts = false
on error resume next
sheets("macro list").delete
on error goto 0
application.displayalerts = true
set olistsheet = activeworkbook.worksheets.add
activesheet.name = "macro list"
icount = 1
olistsheet.range("a1").value = "file name"
olistsheet.range("b1").value = "module name"
olistsheet.range("c1").value = "macro name"
olistsheet.range("d1").value = "full macro name"
olistsheet.range("e1").value = "start line"
olistsheet.range("f1").value = "count lines"
olistsheet.range("g1").value = "calls"
rows("1:1").font.bold = true
cells.columns.autofit
on error resume next
each vbcomp in activeworkbook.vbproject.vbcomponents
    set vbcodemod = activeworkbook.vbproject.vbcomponents(vbcomp.name).codemodule
    intcountlines = vbcomp.codemodule.countoflines
    vbcodemod
        'run through every line of code in module:
        x = 1 intcountlines
        strtemp = trim(vbcomp.codemodule.lines(x, 1))
       
           if left(strtemp, 8) = "function" then
                olistsheet.[a1].offset(icount, 0).value = activeworkbook.name
                olistsheet.[a1].offset(icount, 1).value = vbcodemod
                olistsheet.[a1].offset(icount, 2).value = .procofline(x, vbext_pk_proc)
                olistsheet.[a1].offset(icount, 3).value = strtemp
                olistsheet.[a1].offset(icount, 4).value = x
                olistsheet.[a1].offset(icount, 5).value = intcountlines
                icount = icount + 1
           end if
           if left(strtemp, 16) = "private function" then
                olistsheet.[a1].offset(icount, 0).value = activeworkbook.name
                olistsheet.[a1].offset(icount, 1).value = vbcodemod
                olistsheet.[a1].offset(icount, 2).value = .procofline(x, vbext_pk_proc)
                olistsheet.[a1].offset(icount, 3).value = strtemp
                olistsheet.[a1].offset(icount, 4).value = x
                olistsheet.[a1].offset(icount, 5).value = intcountlines
                icount = icount + 1
           end if
           if left(strtemp, 15) = "public function" then
                olistsheet.[a1].offset(icount, 0).value = activeworkbook.name
                olistsheet.[a1].offset(icount, 1).value = vbcodemod
                olistsheet.[a1].offset(icount, 2).value = .procofline(x, vbext_pk_proc)
                olistsheet.[a1].offset(icount, 3).value = strtemp
                olistsheet.[a1].offset(icount, 4).value = x
                olistsheet.[a1].offset(icount, 5).value = intcountlines
                icount = icount + 1
           end if
           if left(strtemp, 3) = "sub" then
                olistsheet.[a1].offset(icount, 0).value = activeworkbook.name
                olistsheet.[a1].offset(icount, 1).value = vbcodemod
                olistsheet.[a1].offset(icount, 2).value = .procofline(x, vbext_pk_proc)
                olistsheet.[a1].offset(icount, 3).value = strtemp
                olistsheet.[a1].offset(icount, 4).value = x
                olistsheet.[a1].offset(icount, 5).value = intcountlines
                icount = icount + 1
           end if
           if left(strtemp, 11) = "private sub" then
                olistsheet.[a1].offset(icount, 0).value = activeworkbook.name
                olistsheet.[a1].offset(icount, 1).value = vbcodemod
                olistsheet.[a1].offset(icount, 2).value = .procofline(x, vbext_pk_proc)
                olistsheet.[a1].offset(icount, 3).value = strtemp
                olistsheet.[a1].offset(icount, 4).value = x
                olistsheet.[a1].offset(icount, 5).value = intcountlines
                icount = icount + 1
           end if
           if left(strtemp, 10) = "public sub" then
                olistsheet.[a1].offset(icount, 0).value = activeworkbook.name
                olistsheet.[a1].offset(icount, 1).value = vbcodemod
                olistsheet.[a1].offset(icount, 2).value = .procofline(x, vbext_pk_proc)
                olistsheet.[a1].offset(icount, 3).value = strtemp
                olistsheet.[a1].offset(icount, 4).value = x
                olistsheet.[a1].offset(icount, 5).value = intcountlines
                icount = icount + 1
           end if
        next x
    end with
'    set vbcodemod = nothing
next vbcomp
olistsheet.cells.columns.autofit
call add_calls_to_list
'selection.autofilter
activewindow
    .splitcolumn = 0
    .splitrow = 1
end with
activewindow.freezepanes = true
olistsheet.cells.columns.autofit
application.screenupdating = true
application.cursor = xldefault
end sub

sub add_calls_to_list()
dim arr new collection, a
dim afirstarray() variant
dim icount long
dim long
dim istart integer
dim iend integer
dim yrow integer
dim sht
dim mymodulename string
dim mysub string
dim strfindcall string
dim vbcomp object
dim introw integer
dim boofindcall_1 boolean
dim boofindcall_2 boolean
dim boofindcall_3 boolean
dim boofindcall_4 boolean

application.screenupdating = false
set sht = activeworkbook.sheets("macro list")
icount = 2
on error resume next
yrow = 2 sht.cells(sht.rows.count, "a").end(xlup).row
    mymodulename = sht.range("b" & yrow)
    mysub = sht.range("c" & yrow)
'    mysub = "workbook_aftersave"
'    mysub = "workbook_beforesave"
'    mysub = "workbook_sheetactivate"
    on error resume next
    set vbcomp = activeworkbook.vbproject.vbcomponents(mymodulename).codemodule
    if err.number <> 0 then
        msgbox ("module : " & mymodulename & vbcr & "does not exist.")
        exit sub
    end if
    vbcomp
        'get start line number , end line number form sheet
        istart = sht.range("e" & icount)
        if sht.range("f" & icount) = sht.range("f" & icount + 1) then
            iend = sht.range("e" & icount + 1) - 1
        elseif not sht.range("f" & icount) = sht.range("f" & icount + 1) then
            iend = sht.range("f" & icount)
        end if
            introw = 2 sht.cells(sht.rows.count, "a").end(xlup).row
'                rowend = sht.cells(sht.rows.count, "a").end(xlup).row
                strfindcall = sht.range("c" & introw)
'                boofindcall_1 = vbcomp.find("workbook_aftersave", 6, 1, 28, 1, false, false)
'                boofindcall_2 = vbcomp.find("workbook_aftersave", istart, 1, iend, 1, false, false)
'                boofindcall_3 = vbcomp.find(strfindcall, istart, 1, iend, 1, false, false)
'                boofindcall_4 = vbcomp.find(strfindcall, 6, 1, 28, 1, false, false)

'***********************************************************************************************
'this not work correct:
                if vbcomp.find(strfindcall, istart, 1, iend, 1, false, false) = true then
                    afirstarray() = array(strfindcall)
                    redim preserve afirstarray(0 ubound(afirstarray) + 1) variant
                end if
'***********************************************************************************************

            next introw

            'keep unique calls
            each in afirstarray 'keep unique calls
               arr.add a, a
            next a

            'add unique calls columns next 'mysub'
            = 1 arr.count 'add unique calls columns next 'mysub'
               cells(icount, + 6) = arr(i)
            next i
            arr.clear

            icount = icount + 1
            '    debug.print vbcomp.procbodyline(mysub, vbext_pk_proc) 
            '    debug.print vbcomp.procofline(7, vbext_pk_proc)
            '    debug.print vbcomp.proccountlines(mysub, vbext_pk_proc)
            '    debug.print sfdsd = vbcomp.find("peter depraetere", istart, 1, iend, 1, false, false)
            '    debug.print trim(vbcomp.lines(x, 1)) 'geeft de code op regel x weer van vbcomp
    end with
next yrow
end sub

would perhaps have sugestions how make list of subs and with where all subs called on?

just fun, wrote code based on idea, quick , dirty.

works, output helpful? imho no.

andreas.

option explicit

sub test()
  dim wb workbook
  dim vbcomp vbide.vbcomponent
  dim long, j long
  dim mname string, pname string, pkind vbide.vbext_prockind, pline long
 
  dim pkindnames(0 3) string
  pkindnames(vbext_pk_proc) = "proc"
  pkindnames(vbext_pk_get) = "property get"
  pkindnames(vbext_pk_let) = "property let"
  pkindnames(vbext_pk_set) = "property set"
 
  dim dict object 'scripting.dictionary
  dim key string
  dim pitem, items
  dim pnames new collection
  dim pdata new collection
 
  dim pbody string
  dim f long, t long
  dim data
 
  set wb = workbooks("ak.xlam")
 
  'get proc names
  set dict = createobject("scripting.dictionary")
  each vbcomp in wb.vbproject.vbcomponents
    vbcomp.codemodule
      mname = vbcomp.name
      = .countofdeclarationlines + 1 .countoflines
        pname = .procofline(i, pkind)
        pitem = array(mname, pname, pkind)
        key = join(pitem, "|")
        pitem = array(mname, pname, pkind, i)
        if not dict.exists(key) then
          dict.add key, pitem
          pnames.add pname
        end if
      next
    end with
  next
 
  'scan proc calls
  items = dict.items
  = 0 ubound(items)
    mname = items(i)(0)
    pname = items(i)(1)
    pkind = items(i)(2)
    pline = items(i)(3)
    set vbcomp = wb.vbproject.vbcomponents(mname)
    vbcomp.codemodule
      f = .procstartline(pname, pkind)
      t = .proccountlines(pname, pkind)
      pbody = .lines(f, t)
      pdata.add array(mname, pname, pkindnames(pkind), pline, .lines(.procbodyline(pname, pkind), 1))
      each pitem in pnames
        if instr(pbody, pitem) > 0 then
          if pname <> pitem then
            pdata.add array("->", pitem)
          end if
        end if
      next
    end with
  next
 
  'output
  redim data(1 pdata.count, 1 5)
  = 0
  each pitem in pdata
    = + 1
    j = 0 ubound(pitem)
      data(i, j + 1) = pitem(j)
    next
  next
  sheets.add
  range("a1:d1") = array("module", "proc", "kind", "line")
  range("a2").resize(ubound(data), ubound(data, 2)).value = data
end sub

Office / Excel / Windows other / Office 2010