미해결 엑셀2021윈도우10
빠른실행도구모음 리스트 구하기
나 빠른실행도구모음리스트를 구하는데 매크로 이름이랑 매크로 파일 위치를(모듈까지) 구하고 싶습니다.
검색해도 잘안나고오 구글제미니 챗gpt 뤼튼 코파일럿등으로 해도 아래같은 코드만 알려주고 정상적으로 작동이 안됩니다.
SSub ListQuickAccessMacros()
Dim cb As CommandBar
Dim ctl As CommandBarControl
On Error Resume Next
Set cb = Application.CommandBars("Quick Access Toolbar")
On Error GoTo 0
If cb Is Nothing Then
MsgBox "빠른 실행 도구 모음을 찾을 수 없습니다.", vbExclamation
Exit Sub
End If
For Each ctl In cb.Controls
If ctl.OnAction <> "" Then
Debug.Print "매크로 이름: " & ctl.OnAction
Debug.Print "매크로 위치: " & ctl.Parameter
End If
Next ctl
End Sub
검색해도 잘안나고오 구글제미니 챗gpt 뤼튼 코파일럿등으로 해도 아래같은 코드만 알려주고 정상적으로 작동이 안됩니다.
SSub ListQuickAccessMacros()
Dim cb As CommandBar
Dim ctl As CommandBarControl
On Error Resume Next
Set cb = Application.CommandBars("Quick Access Toolbar")
On Error GoTo 0
If cb Is Nothing Then
MsgBox "빠른 실행 도구 모음을 찾을 수 없습니다.", vbExclamation
Exit Sub
End If
For Each ctl In cb.Controls
If ctl.OnAction <> "" Then
Debug.Print "매크로 이름: " & ctl.OnAction
Debug.Print "매크로 위치: " & ctl.Parameter
End If
Next ctl
End Sub
김
숫
아
혀
신
선
댓글 1
Excel Customizations.exportedUI 사용자정의모음 텍스트 파일로 열어서
a1셀에 넣는다
Sub SplitXMLText()
Dim ws As Worksheet
Dim cell As Range
Dim text As String
Dim lines() As String
Dim i As Integer
Range("C1:C200").ClearContents
' 현재 워크시트 설정
Set ws = ActiveSheet
' MsgBox ws
' 분리할 텍스트가 있는 셀 설정
Set cell = ws.Range("A1")
' 셀의 텍스트 가져오기
text = cell.Value
' 텍스트를 "><"로 분리
lines = Split(text, "><")
' 분리된 텍스트를 셀에 출력
For i = LBound(lines) To UBound(lines)
ws.Cells(i + 1, 3).Value = "<" & lines(i) & ">"
Next i
End Sub
텍스트 나눈다
=ExtractLabel(C2)
=ExtractOnAction(C2)
Function ExtractLabel(xmlText As String) As String
Dim labelStart As Long, labelEnd As Long
Dim idQStart As Long, idQEnd As Long
Dim extractedLabel As String
On Error Resume Next
' Try to extract the label if it exists
labelStart = InStr(xmlText, "label=""") + Len("label=""")
If labelStart > Len("label=""") Then
labelEnd = InStr(labelStart, xmlText, """")
extractedLabel = Mid(xmlText, labelStart, labelEnd - labelStart)
Else
' If label doesn't exist, try to extract idQ as a fallback
idQStart = InStr(xmlText, "idQ=""") + Len("idQ=""")
If idQStart > Len("idQ=""") Then
idQEnd = InStr(idQStart, xmlText, """")
extractedLabel = Mid(xmlText, idQStart, idQEnd - idQStart)
Else
extractedLabel = "" '"No label or idQ found"
End If
End If
' Optional: Clean up any unwanted parts, removing specific terms
extractedLabel = Application.WorksheetFunction.Substitute(extractedLabel, "ontrol idQ=", "")
extractedLabel = Application.WorksheetFunction.Substitute(extractedLabel, "ontrol id=", "")
extractedLabel = Application.WorksheetFunction.Substitute(extractedLabel, "ab idQ=", "")
extractedLabel = Application.WorksheetFunction.Substitute(extractedLabel, "roup idQ=", "")
extractedLabel = Application.WorksheetFunction.Substitute(extractedLabel, "ustomUI xmlns:x1=", "")
extractedLabel = Application.WorksheetFunction.Substitute(extractedLabel, "mso:", "")
On Error GoTo 0
ExtractLabel = extractedLabel
End Function
Function ExtractOnAction(xmlText As String) As String
Dim onActionStart As Long, onActionEnd As Long
On Error Resume Next
onActionStart = InStr(xmlText, "onAction=""") + Len("onAction=""")
onActionEnd = InStr(onActionStart, xmlText, """")
ExtractOnAction = Mid(xmlText, onActionStart, onActionEnd - onActionStart)
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "rol idQ=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "rol id=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "rol id=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "omUI xmlns:x1=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "p idQ=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "idQ=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "p idQ=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "p id=", "")
ExtractOnAction = Application.WorksheetFunction.Substitute(ExtractOnAction, "id=", "")
On Error GoTo 0
End Function