ＡＩ生成マクロと現存マクロのコラボ　プロシージャ抽出　文字数カウント

Sub CpySubColA()
Dim selectedCell As Range
Dim macroName As String
Dim moduleName As String
Dim codeLines As String
Dim line As String
Dim i As Long, j As Long
Dim ws As Worksheet
' Set the active sheet
Set ws = ActiveSheet
' Clear column A
ws.Columns("A").ClearContents
' Get the selected cell
If Selection.Cells.Count = 1 Then
Set selectedCell = Selection
macroName = Trim(selectedCell.Value)
Else
Call MsgInfo(5, "Please select one cell.")
Exit Sub
End If
If macroName = "" Then
Call MsgInfo(5, "There is no macro name in the selected cell.")
Exit Sub
End If
' Search for macro in standard modules
With ThisWorkbook.VBProject
For i = 1 To .VBComponents.Count
If .VBComponents(i).Type = vbext_ct_StdModule Then
moduleName = .VBComponents(i).Name
codeLines = .VBComponents(moduleName).CodeModule.lines(1, _
.VBComponents(moduleName).CodeModule.CountOfLines)
' Search for macro name
If InStr(1, codeLines, "Sub " & macroName & "(", vbTextCompare) > 0 Then
' If the corresponding module is found
Exit For
End If
moduleName = "" ' Reset if not found
End If
Next i
End With
If moduleName = "" Then
Call MsgInfo(5, "Macro name '" & macroName & "' was not found.")
Exit Sub
End If
' Copy macro code to column A
With ThisWorkbook.VBProject.VBComponents(moduleName).CodeModule
j = 1
For i = 1 To .CountOfLines
line = .lines(i, 1)
If InStr(1, line, "Sub " & macroName & "(", vbTextCompare) > 0 Or j > 1 Then
ws.Cells(j, 1).Value = line
j = j + 1
If InStr(1, line, "End Sub", vbTextCompare) > 0 Then Exit For
End If
Next i
End With
Call MsgInfo(5, "Macro '" & macroName & "' was copied to column A.")
End Sub

Sub CountColA()
Dim NumChar As Long, NumByte As Long
Dim cell As Range
Dim lastRow As Long
' Identify the last used row in column A
lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
NumChar = 0
NumByte = 0
' Loop through the range from the first to the last used cell in column A
For Each cell In ActiveSheet.Range("A1:A" & lastRow)
If Not isEmpty(cell.Value) Then
NumChar = NumChar + Len(cell.Value)
NumByte = NumByte + LenB(StrConv(cell.Value, vbFromUnicode))
End If
Next cell
' Create message for display
MsgText = "Information column A" & vbCrLf & _
vbCrLf & Format(NumChar, "#,##0") & " Characters" & _
vbCrLf & Format(NumByte, "#,##0") & " Bytes"
Call MsgInfo(5, MsgText)
End Sub