ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] VBA±M®×¤ºµ{§Ç½Õ¥ÎÃö«Y

[µo°Ý] VBA±M®×¤ºµ{§Ç½Õ¥ÎÃö«Y

½Ð°Ý¦p¦ó²£¥Í¦p¤UªºVBAµ{§Ç½Õ¥ÎªºÃö«Yªí
      
    »¡©ú¡G
            1. ¤@­ÓVBA±M®×¤º¥i¯à¦³³\¦h¼Ò²Õ¦p¹Ïªí¤¤ªº ¦æ"A"¡A
            2. ¦U¼Ò²Õ¤º¦³¦³³\¦h¤lµ{§Ç sub( )¡Bfunction( ) ¦p¹Ïªí¤¤ªº ¦æ "B"
            3. ªí¤¤ªº¼Ò²Õ¦WºÙ¤Îµ{§Ç¦WºÙ¬O¬°»¡©úµêÀÀªº            
            4. µ{§Ç¤¤·|©I¥s½Õ¥Î¡Aµ{§Ç¦h¤F´NÃø§ä¨ì¥»µ{§Ç¬O¥Î¨ì­þ¤@­Ó¼Ò²Õ¤ºªº¨º¤@­Óµ{§Ç¡F
                ¤Ï¤§¡A¤@­Óµ{§Ç½Õ¥Î¬Y¤@­Óµ{§Ç«o¤£ª¾¦b¨º¤@­Ó¼Ò²Õ¤º¡C®É¶¡¤[¤F­n°µ­×§ï©Î debug´N§xÂZ¤F¡C
                (·íµM¡A¦b¼gµ{§Ç®É¦h¥[³Æµù´N¦n¤F¡A«¢«¢¡C)
            5. Á|¨Ò¡A¤W¹Ïªí¤¤ªí¥Ü ¦¹VBA±M®×¦³ A ¦æ¤¤ 3­Ó¼Ò²Õ(Mod1,Mod2,Mod3)¡A
                 B ¦æ¤¤¦U¼Ò²Õ¤º¦³¨ä ¤lµ{§Ç(sub11( ),sub12( ).......sub33( ),¨ç¼Æ (fun13,.....,fun36( )  )¡A
                 ²Ä2¦C¡A ¦ì©ó¼Ò²ÕMod1 ¤ºªº¤lµ{§Ç sub11( ) ³Q ¦ì©ó ¼Ò²Õ Mod3 ªº sub31( ) ¤Î ¼Ò²Õ Mod3 ªº sub33( ) ½Õ¥Î
                 ²Ä3¦C ¡A Mod1¤ºªº sub12( ) ¨S³Q½Õ¥Î ¡A¤]³\¦³½Õ¥Î¨ä¥Lµ{§Ç
                  .
                  .
                  ²Ä16¦C¡A ¼Ò²Õ Mod3 ¤ºªº¨ç¼Æ fun36( ) ¦³³Q Mod2 ªºfun24( ) ¤Î Mod3 ªº sub31( ) ¤Î Mod3 ªº fun35( ) ½Õ¥Î¡C

          ½Ð¤j¤j­Ì¨ó§UÀ°¦£¡C
           ·P®¦

¦^´_ 1# Scott090

     ¥ý¬ãÀÀ¸ÑÃDµ¦²¤
1. ¥ý±q¥»workbook ¤§ VBComponents ¨ú±o ¦UÃþ Module¡BClass ¤Î¨ä¤¤ªº sub¡Bfunction¡Bproperty
     ½T©wworkbook¦³¨º¤@¨Ç ¼Ò²Õ¤Î¨ä¤lµ{§Çµ¥¡C
2. §â ¦b²Ä1. ¤º¨ú±oªº ¼Ò²Õ¤Î¦U¦Ûªº ¤lµ{§Ç¡B¨ç¼Æ µ¥ ©ñ¤J ¦r¨å¡C
3. ±q VBComponents ¤ºªº ¨C±ø code statement ¤ñ¹ï¨ì ¦r¨å¨ú¥X ­þ¤@­Ó ¼Ò²Õªº­þ¤@­Ó sub¡Bfunction µ¥ªº¦WºÙ³Q½Õ¥Î¤F¡C
4. 2 ­Óª`·NÂI¬O ³Æµù ©Î ¥Î " : " ³s¦ê¦A¤@°_ªº µ{§Ç½X»y¥y
5. ¾ã²z²Ä3. ªºµ²ªG ¥i±o ­þ¤@ªº¼Ò²Õªº­þ¤@­Ó¤lµ{§Çµ¥³Q ­þ¤@­Ó¤lµ{§Çµ¥½Õ¥Î
6. §¹¦¨ °ÝÃDªº ½Õ¥Îªí

    ¥H¤W¶È¨Ñ¤j¤j­Ì°Ñ¦Ò ¨Ã «ü¾É
   
    ÁÂÁÂ

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-4-20 15:54 ½s¿è

¦^´_ 2# Scott090

ÁÂÁ«e½úµoªí¦¹¥DÃD
«á¾Ç¦³½ÆÂø½Õ¥Î®×¤l,«Ü·Q¾Ç³o©«Ãö«Yªíªºª¾ÃÑ,½Ð«e½ú«ü¾É,ÁÂÁ«e½ú
½Ð±Ð«e½ú:
1. ¥ý±q¥»workbook ¤§ VBComponents ¨ú±o ¦UÃþ Module¡BClass ¤Î¨ä¤¤ªº sub¡Bfunction¡Bproperty
     ½T©wworkbook¦³¨º¤@¨Ç ¼Ò²Õ¤Î¨ä¤lµ{§Çµ¥¡C

«á¾Ç¦³§ä¨ì http://forum.twbts.com/viewthrea ... ght=VBComponents%2B
³o©« ªüÀs«e½úªº¸Ñµª,¦ý¬O¥u¦³(¬¡­¶Ã¯¦WºÙ,¼Ò²Õ¦WºÙ,µ{§Ç¦WºÙ),³o¼Ë¦n¹³µLªkª¾¹D½Õ¥ÎÃö«Y,½Ð«e½ú«ü¾É

°õ¦æµ²ªG:



Sub §ä¥¨¶°¦WºÙ()
Application.DisplayAlerts = False
[A1] = "¬¡­¶Ã¯¦WºÙ"
[B1] = "¼Ò²Õ¦WºÙ"
[C1] = "µ{§Ç¦WºÙ"
R = 2
Set WB = ThisWorkbook
  For Each VBC In WB.VBProject.VBComponents
    Select Case VBC.Type
      Case 1  '1=¤@¯ë¼Ò²Õ
        LS = VBC.CodeModule.CountOfLines
        'Debug.Print LS
        LineStr = VBC.CodeModule.Lines(1, LS)
        Lines = Split(LineStr, vbCrLf)
        For Each Line In Lines
            If Line Like "Sub*" Then
              Cells(R, 1) = WB.Name
              Cells(R, 2) = VBC.Name
              Cells(R, 3) = Line
              R = R + 1
            End If
        Next 'Line
      Case Else
    End Select
  Next  'VBC
Columns.AutoFit
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 3# Andy2483

  ¤j¤j¶Kªºµ{§Ç§Ú¦³«ôŪ¹L¡C
  ¦]¬°©|µL°ª¤H¨ó§U¸Ñµª¡A©Ò¥H§Ú¥ý´£¥X¦Û¤vªººc«ä¤è¦V¡A»Ý­nÄ~Äò§V¤O¥h¨D±o¸Ñ¤è¡C
  
¤@°_§V¤O§a¡A´Á±æ¦³¦nµ²ªG
    ·íµM¦p¦³°ª¤HÄ@µ¹«ü¾É¡A«D±`·P®¦

TOP

¦^´_ 4# Scott090


    ÁÂÁ«e½ú¦^´_
«e½úª¾¹D¦p¦ó±Nvbaªºµ{¦¡½X¶×¨ì¤u§@ªíÀx¦s®æ¸Ì¶Ü?
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 5# Andy2483

§â 3# ¼Óªºµ{¦¡½X­×§ï¦p¤U ´ú¸Õ¡C
  Sub §ä¥¨¶°¦WºÙ()
Application.DisplayAlerts = False
'[A1] = "¬¡­¶Ã¯¦WºÙ"
'[B1] = "¼Ò²Õ¦WºÙ"
'[C1] = "µ{§Ç¦WºÙ"
R = 1  '2
ActiveSheet.Cells.Clear
Set WB = ThisWorkbook
  For Each VBC In WB.VBProject.VBComponents
    Select Case VBC.Type
      Case 1  '1=¤@¯ë¼Ò²Õ
        LS = VBC.CodeModule.CountOfLines
        'Debug.Print LS
        LineStr = VBC.CodeModule.Lines(1, LS)
        Lines = Split(LineStr, vbCrLf)
               
        For Each Line In Lines
            Cells(R, 1) = IIf(Left(Line, 1) = "'", "'" & Line, Line)  'ÁקK³Æµù²Å¸¹ ' ¦bÀx¦s®æ³Qµø¬°¤@¯ë¤å¦r®æ¦¡

'            If Line Like "Sub*" Then
'              Cells(R, 1) = WB.Name
'              Cells(R, 2) = VBC.Name
'              Cells(R, 3) = Line
              R = R + 1
'            End If
        Next 'Line
      Case Else
    End Select
  Next  'VBC
Columns.AutoFit
End Sub

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-4-21 15:18 ½s¿è

¦^´_ 6# Scott090


    ÁÂÁ«e½ú«ü¾É,«á¾Ç¦³´ú¸Õ¦¨¥\
¥Ø«e·Pı#3¼Ó + #6¼Óªº¿é¥Xµ²ªG¥i¥H§ì¥X¤@¯ë¼Ò²Õªºµ{§Ç½Õ¥ÎÃö«Y

¤£ª¾¹D¦³¨S¦³Ãþ¦ü¾ðª¬Ãö«Y¹Ï¥i¥H¬d¬Ý,¤£µM¹³±M·~½ÆÂøÂIªºµ{¦¡«ç»òºÞ²z?
«á¾Ç¾Ç±o¤Ó²L¤F,ÁÂÁ«e½ú
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 7# Andy2483


    ½Ð°Ñ·Ó 2# ªº «ä¦Ò¡G
            2. §â ¦b²Ä1. ¤º¨ú±oªº ¼Ò²Õ¤Î¦U¦Ûªº ¤lµ{§Ç¡B¨ç¼Æ µ¥ ©ñ¤J ¦r¨å¡C
            3. ±q VBComponents ¤ºªº ¨C±ø code statement ¤ñ¹ï¨ì ¦r¨å¨ú¥X ­þ¤@­Ó ¼Ò²Õªº­þ¤@­Ó sub¡Bfunction µ¥ªº¦WºÙ³Q½Õ¥Î¤F¡C

      ÁÂÁÂ

TOP

¦^´_ 7# Andy2483

  ¨ú¥X¦U¼Ò²Õ¤ºªºµ{§Ç¡A¦A°µ¥æ¤e¤ñ¹ï¡C
  ¦ý¨C¤H¼gµ{¦¡ªº­·®æ¤£¦P¡AÀ³¸Ó»Ý­n¥t¦æ¦Ò¼{­×¹¢©Î¦³¨ä¥L§ó¦nªº°µªk¡C
  ¥H¤U¬O§Ú¦Û¤v¦¨¥\´ú¸Õ¥Îµ{¦¡¡A ½Ð´ú¸Õ¦Û¤vªº±M®×µ{¦¡¸Õ¸Õ¬Ý¡C
  
'°Ñ¦Ò https://ithelp.ithome.com.tw/questions/10202519
    Option Explicit
Option Base 1

Private Sub GetModules()
    Dim wb As Workbook, sh As Worksheet
    Dim k&, RowNum%, c
    Dim VBC, CodeStrs
    Dim arrProc$(), arrB
    Set wb = ThisWorkbook
    Set sh = Sheets("MacroList")    'µ{§Ç½Õ¥Î¤u§@ªí
    sh.Cells.Clear
    sh.Select
    Range("A1").Select
   
    Set VBC = wb.VBProject.VBComponents
    RowNum = 0
    ReDim arrProc(5, 1)
    For Each c In VBC
         RowNum = ListProcedures(c.CodeModule.Name, RowNum, arrProc)
    Next
   
    Call µ{§Ç½Õ¥Îªí(arrProc)

       '§â¥æ¤e¤lµ{§Ç½Õ¥Îªí©ñ¤J¤u§@ªí "MacroList"
     [A1:E1] = Array("¼Ò²Õ¦W", "³Q½Õµ{§Ç¦W", "µ{§ÇÃþ§O", "¼Ò²Õ°_©l¦æ¡A¦æ¼Æ", "½Õ¥Î¼Ò²Õ.µ{§Ç")
   
    '­áµ²²Ä¤@¦C Äæ¦ì¦WºÙ
    Range("A2").Select
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True

    [A2].Resize(RowNum, 5) = Application.Transpose(arrProc)
    Set wb = Nothing  
End Sub

Function ListProcedures(ModuleName$, RowNum%, arrProc) As Integer   
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim LineNum&, lineStr$, CodeStrs, startLineNum&, endLineNum&
    Dim ProcLineCount&, LS&
    Dim sh As Worksheet
    Dim Rng As Range
    Dim ProcName As String
    Dim ProcKind As vbext_ProcKind   'µ{§ÇºØÃþ modules, sub( ) or function( ),property get,property Let, property set
   
    Set VBProj = ActiveWorkbook.VBProject
    Set VBComp = VBProj.VBComponents(ModuleName)    'VBComp ¬O ¼Ò²Õ¦WºÙ¤ºªº¤¸¥ó
    Set CodeMod = VBComp.CodeModule
    Set sh = ActiveWorkbook.Worksheets("MacroList")         '³]©w¤@½Õ¥Îªíªº¤u§@ªí
    sh.Select
   
    LS = CodeMod.CountOfLines       '³o­Ó¼Ò²Õ¤º(©Ò¦³ªºµ{§Ç)µ{¦¡½X»y¥yªº¦æ¼Æ
        '¦³¼Ò²Õ¦W¦ý¨S¦³µ{§Ç½X«h¸õ¹L
    If LS = 0 Then GoTo ExitFunction   
  
   With CodeMod        '¦b³o­Ó¼Ò²Õ¤º
      LineNum = .CountOfDeclarationLines + 1    'µ{§Ç«eªº«Å§i¦C¤Î³Æµù¦C¼Æ
      Do Until LineNum >= .CountOfLines         'CountOfLines ¼Ò²Õµ{§Ç½XÁ`¦æ¼Æ
        RowNum = RowNum + 1
        ReDim Preserve arrProc(5, RowNum)
        ProcName = .ProcOfLine(LineNum, ProcKind)   'µ{§Ç¤º¥ô¦ó¦æ½X LineNum ¥i·j´Mµ{§Ç¦WºÙ
        arrProc(1, RowNum) = ModuleName: arrProc(2, RowNum) = ProcName: arrProc(3, RowNum) = ProcKindString(ProcKind)
               
        startLineNum = .ProcBodyLine(ProcName, ProcKind)   'µ{§Ç¶}©l¦æ½X
        ProcLineCount = .ProcCountLines(ProcName, ProcKind)    'µ{§Ç¦æ¼Æ
'        endLineNum = .ProcendLine(ProcName, ProcKind)
        arrProc(4, RowNum) = startLineNum & ", " & ProcLineCount
        
'        Cells(RowNum + 1, "D") = startLineNum & ", " & ProcLineCount
        LineNum = startLineNum + ProcLineCount + 1         '¦P¤@¼Ò²Õ¤§¤U¤@­Óµ{§Ç¶}©l¦æ½X µ{§Ç¶}©l¼Æ + µ{§Çªø«×
      Loop
    End With
ExitFunction:
    ListProcedures = RowNum
End Function


Function ProcKindString$(ProcKind As VBIDE.vbext_ProcKind) 'As String
    Select Case ProcKind
      Case vbext_pk_Get
          ProcKindString = "Property Get"
      Case vbext_pk_Let
          ProcKindString = "Property Let"
      Case vbext_pk_Set
          ProcKindString = "Property Set"
      Case vbext_pk_Proc
          ProcKindString = "Sub Or Function"
      Case Else
          ProcKindString = "Unknown Type: " & CStr(ProcKind)
    End Select
End Function

'°Ñ¦Ò Searching For Text In A Module   http://www.cpearson.com/excel/vbe.aspx
Sub µ{§Ç½Õ¥Îªí(arrProc)      '(FindWhat$)       '·j´M ½Õ¥Îªº¤lµ{§Ç»P¨ç¼Æ¦WºÙ¦r¦ê
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponents
    Dim VBC              'As Object
    Dim CodeMod As VBIDE.CodeModule
    Dim ProcName As String
    Dim ButtonStr$                          '¦Û­q¥t¦C Command Bar «ö¶s¦r¦ê
    Dim ProcKind As VBIDE.vbext_ProcKind   'µ{§ÇºØÃþ modules, sub( ) or function( ),property get,property Let, property set
    Dim wb As Workbook
    Dim lineStr$, CodeStrs, Proc
    Dim i&, j&, RowNum&, comma$
    Dim SL&, SL0& ' start line
    Dim EL& ' end line
    Dim SC&, SC0& ' start column
    Dim EC&, EC0& ' end column
    Dim Found As Boolean
        
    '¤Þ¥Î¶µ¡G Microsoft Visual Basic for Applications Extensibility 5.3
    '    AddExtenReference   '¥[¤J¤Þ¥Î¶µ
    Set wb = ThisWorkbook
    Set VBProj = wb.VBProject
    Set VBComp = VBProj.VBComponents    '(ModuleNames)
   
    For i = 1 To UBound(arrProc, 2)
'        Debug.Print arrProc(2, i)
        comma = ""
        For Each VBC In VBComp
            Set CodeMod = VBC.CodeModule
            With CodeMod
            
                '¥»¼Ò²Õ¬O§_¦³µ{¦¡½X
                If .CountOfLines < 2 Then GoTo next_VBC
        '========== ³]©w·j´M°_©lÂI ==========================================================
                SC0 = 1 '¤w·j´M¤å¦r¦êªº¤W¤@­Ó¦ì¸m
                SL = .CountOfDeclarationLines + 1   '±q«Å§i¦æ«áªº²Ä¤@¦æ¶}©l·j´M
                EL = .CountOfLines
                SC = 0: EC0 = 0: EC = 1023
               
                Found = .Find(Target:=arrProc(2, i), _
                    startline:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, _
                    wholeword:=True, MatchCase:=True, patternsearch:=False)
               
                '¦b¦P¤@¼Ò²Õ¤º¤ÏÂзj´M
                Do Until Found = False
                    If SL = Split(arrProc(4, i), ",")(0) Then GoTo 101        '§ä¨ìªº¬Oµ{§Ç©Î¨ç¼Æ©w¸q¥»¨­ªº¦WºÙ
                    lineStr = Trim(Left(.Lines(SL, 1), SC - 1)) '§ä¨ìªº¦r¦ê«e­±ªº¦r¦ê
                    
                     '¦Û­q¥t¦CCommand Bar «ö¶s¦r¦ê
                    If InStr(lineStr, "OnAction =") <> 0 Then
                        ButtonStr = ". " & Replace(Mid(Trim(.Lines(SL - 1, 1)), 12), Chr(34), "")  'len(".caption = ") =11
                        GoTo 100
                    End If
                    
'                    ¦r¦ê¦³ "' "¡B"Sub"¡B "Function"¡B ' "'«h§ä¨ìªº¦r¦ê¥i¯à¤£¬O¦b©I¥sµ{§Ç©Î¬Oµ{§ÇÀY
                    If InStr(lineStr, Chr(39)) <> 0 Or _
                       InStr(lineStr, "Sub") <> 0 Or _
                       InStr(lineStr, "Function") Or _
                       Right(lineStr, 1) = Chr(34) Then GoTo 101
100
                    ProcName = .ProcOfLine(SL, ProcKind)    '·j´M¨ìªº¦r¦ê¦b¨º­Ó¤lµ{§Ç©Î¨ç¼Æ
                    If ProcName <> arrProc(2, i) Then
                       arrProc(5, i) = arrProc(5, i) & comma & .Name & "." & ProcName & ButtonStr
                        comma = ", ": ButtonStr = ""
                    End If
                    
                    '¦b§ä¨ì¦r¦êªº¦P¤@¦æªº¤U¤@­Ó¦rÄ~Äò·j´M
                    EL = .CountOfLines
                    SC = EC:  EC = 1023
                    GoTo 102
101
                    '±q¤U¤@¦æªº°_©l¦CÄ~Äò·j´M
                    SL0 = SL: SL = SL + 1
                    SC0 = 0: SC = 0
                    EC0 = 0: EL = .CountOfLines
                    EC = 1023        '³Ì¦h¤@¦r¦ê¤§­­©wªø«× 1023­Ó¦r
102
                    Found = .Find(Target:=arrProc(2, i), startline:=SL, StartColumn:=SC, _
                        EndLine:=EL, EndColumn:=EC, _
                        wholeword:=True, MatchCase:=True, patternsearch:=False)
                Loop
            End With
next_VBC:
        Next  'Module
Next_i:
    Next     'i ,next Procedure being called
   
End Sub

TOP

        ÀR«ä¦Û¦b : µÊ®ð¼L¤Ú¤£¦n¡A¤ß¦a¦A¦n¤]¤£¯àºâ¬O¦n¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD