怎样在多个模块里，快速查找和定位指定的自定义函数或sub过程代码所在位置？

lss001

WYS67 发表于 2020-2-8 13:38
首先，非常感谢老师数次费心编写代码！

    感觉用了这个新修改的代码，刷下去许多名称【包括许多不带 ...

无测试，如果不对可改为.ProcCountLines(n, k) - 1，见楼上最新

WYS67

lss001 发表于 2020-2-8 14:39
无测试，如果不对可改为.ProcCountLines(n, k) - 1，见楼上最新

经一个个对照检测，您这次编写的代码完全正确！

再次感谢老师！！！

WYS67

lss001 发表于 2020-2-8 12:17
见楼上更正即可！！！

老师：如上面截图所示，我想在sheet2的A:B里显示代码结果，点击宏按钮后，其它都能正确显示，就是A3始终显示Sheet1，
  请问：需要修改下面哪个地方的代码，才能使A3显示sheet2？

Sub hhh()
    On Error Resume Next '以下添加引用
    Dim ws As Object, vn$, kx$, ky$, i&
    SendKeys "%tms%e~" 'excel启用所有宏
    SendKeys "%tms%v~" 'excel信任对工程对象模型的访问
    For i = 1 To 100: DoEvents: Next
    Set ws = CreateObject("wscript.Shell")
    vn = Excel.Application.Version 'office版本 //Word
    kx = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
        vn & "\Excel\Security\VBAWarnings" '//Word
        'office2016及以上/VBAWarnings,其它版本/Level
    ky = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
        vn & "\Excel\Security\AccessVBOM" '//Word
    If ws.regread(kx) <> 1 Then ws.RegWrite kx, 1, "REG_DWORD"
    '1启用所有宏/2禁用且通知/3禁用无签宏/4禁用不通知 //宏安全性
    If ws.regread(ky) = 0 Then ws.RegWrite ky, 1, "REG_DWORD"
    SendKeys "~" '0关闭/1开启 //信任对工程对象模型的访问
    Application.CommandBars.FindControl(ID:=3627).Execute
    Set myr = ThisWorkbook.VBProject.References.AddFromGuid _
    ("{000204EF-0000-0000-C000-000000000046}", 4, 2)
    Set myr = ThisWorkbook.VBProject.References.AddFromGuid _
   ("{0002E157-0000-0000-C000-000000000046}", 5, 3)
    Call mjsyqqs
End Sub

Sub mjsyqqs()
    Dim ct As Object, n$, k&, d&
    [a:b] = "": [a1] = "工程名": [b1] = "过程名": x = 2
    Set xx = GetObject(ThisWorkbook.Path & "\自定义.xlsm")
    For Each ct In xx.VBProject.VBComponents
        With ct.CodeModule
            Cells(x, 1) = .Name
            d = .CountOfDeclarationLines + 1
            Do While d < .CountOfLines
                n = .ProcOfLine(d, k)
                If InStr(.Lines(.ProcStartLine(n, k), .ProcCountLines(n, k) - 1), "Private") = 0 Then
                    If n <> "" Then i = i + 1: Cells(i + x - 1, 2) = n
                    y = xx.FullName & "#" & ct.CodeModule.Name & "." & n
                    Sheet1.Hyperlinks.Add Cells(i + x - 1, 2), y
                End If
                d = .ProcStartLine(n, k) + .ProcCountLines(n, k) + 1
            Loop
        End With
        If d <= 2 Then x = x + 1 Else x = x + i: i = 0
    Next
End Sub

WYS67

lss001 发表于 2020-2-7 22:34
Sub mjsyqqs()
    Dim ct As Object, n$, k&, d&
    [a:b] = "": [a1] = "工程名":  = "过程名": x = ...

代码如下：

Sub hhh()
    On Error Resume Next '以下添加引用
    Dim ws As Object, vn$, kx$, ky$, i&
    SendKeys "%tms%e~" 'excel启用所有宏
    SendKeys "%tms%v~" 'excel信任对工程对象模型的访问
    For i = 1 To 100: DoEvents: Next
    Set ws = CreateObject("wscript.Shell")
    vn = Excel.Application.Version 'office版本 //Word
    kx = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
        vn & "\Excel\Security\VBAWarnings" '//Word
        'office2016及以上/VBAWarnings,其它版本/Level
    ky = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
        vn & "\Excel\Security\AccessVBOM" '//Word
    If ws.regread(kx) <> 1 Then ws.RegWrite kx, 1, "REG_DWORD"
    '1启用所有宏/2禁用且通知/3禁用无签宏/4禁用不通知 //宏安全性
    If ws.regread(ky) = 0 Then ws.RegWrite ky, 1, "REG_DWORD"
    SendKeys "~" '0关闭/1开启 //信任对工程对象模型的访问
    Application.CommandBars.FindControl(ID:=3627).Execute
    Set myr = ThisWorkbook.VBProject.References.AddFromGuid _
    ("{000204EF-0000-0000-C000-000000000046}", 4, 2)
    Set myr = ThisWorkbook.VBProject.References.AddFromGuid _
   ("{0002E157-0000-0000-C000-000000000046}", 5, 3)
    Call mjsyqqs
End Sub

Sub mjsyqqs()
    Dim ct As Object, n$, k&, d&
    [a:b] = "": [a1] = "工程名": [b1] = "过程名": x = 2
    Set xx = GetObject(ThisWorkbook.Path & "\自定义.xlsm")
    For Each ct In xx.VBProject.VBComponents
        With ct.CodeModule
            Cells(x, 1) = .Name
            d = .CountOfDeclarationLines + 1
            Do While d < .CountOfLines
                n = .ProcOfLine(d, k)
                If InStr(.Lines(.ProcStartLine(n, k), .ProcCountLines(n, k) - 1), "Private") = 0 Then
                    If n <> "" Then i = i + 1: Cells(i + x - 1, 2) = n
                    y = xx.FullName & "#" & ct.CodeModule.Name & "." & n
                    Sheet1.Hyperlinks.Add Cells(i + x - 1, 2), y
                End If
                d = .ProcStartLine(n, k) + .ProcCountLines(n, k) + 1
            Loop
        End With
        If d <= 2 Then x = x + 1 Else x = x + i: i = 0
    Next
End Sub


老师：如图所示，需要把查询结果存放在C:D列，1.修改[a:b] = "": [a1] = "工程名": [b1] = "过程名": x = 2为[c:d] = "": [c1] = "工程名": [d1] = "过程名": x = 2；
       2.修改Cells(x, 1) = .Name为Cells(x, 3) = .Name；
       3.还需修改哪个地方，才能使原先显示在B列的自定义函数名称显示在D列里？

lss001

WYS67 发表于 2020-2-8 19:20
代码如下：

Sub hhh()

参考15楼》》》'存放至Sheet2!c:d列

WYS67

lss001 发表于 2020-2-8 22:38
参考15楼》》》'存放至Sheet2!c:d列

感谢老师！