2年ほど前に書いたPowerPointマクロの記事「クイックアクセスツールバーからPowerPointマクロを実行するアドインの紹介」に対して、アドインのコードを見たいというコメントがあったので、コードをそのまま載せることにします。
・リボンXML
<?xml version="1.0" encoding="utf-8"?> <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"> <ribbon> <tabs> <tab id="tabCallProc" label="マクロ呼出" visible="false"> <group id="grpCallProc" label="マクロ呼出"> <dynamicMenu id="dmuCallProc" label="マクロ呼出" imageMso="VisualBasic" size="normal" screentip="マクロ呼出メニュー" supertip="登録されたアドインのマクロを実行します。" getContent="dmuCallProc_getContent" /> </group> </tab> </tabs> </ribbon> </customUI>
・標準モジュール
Option Explicit Public Sub dmuCallProc_getContent(control As IRibbonControl, ByRef returnedVal) Dim DataFilePath As String Dim buf As String Dim ff As Integer Dim d As Object Dim elmMenu As Object Dim elmButton As Object Dim v As Variant Dim i As Long Dim j As Long Const MyAddInName As String = "CallProcAddin" 'このアドイン名 Const DataFileName As String = "macrodat.txt" 'マクロデータ名 Const BtnID As String = "btnCallProc" On Error Resume Next If Application.AddIns(MyAddInName).Loaded <> msoTrue Then MsgBox "アドインが読み込まれていません。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal Exit Sub End If On Error GoTo 0 DataFilePath = Application.AddIns(MyAddInName).Path If Right$(DataFilePath, 1) <> "\" Then DataFilePath = DataFilePath & "\" DataFilePath = DataFilePath & DataFileName Set d = CreateObject("Msxml2.DOMDocument") Set elmMenu = d.createElement("menu") elmMenu.setAttribute "xmlns", "http://schemas.microsoft.com/office/2006/01/customui" elmMenu.setAttribute "itemSize", "normal" If Len(Dir$(DataFilePath)) < 1 Then Set elmButton = d.createElement("button") With elmButton .setAttribute "id", BtnID .setAttribute "label", "マクロデータが見つかりません。" .setAttribute "imageMso", "QueryRunQuery" .setAttribute "screentip", "マクロデータが見つかりません。" .setAttribute "supertip", "[" & DataFilePath & "]ファイルがあるかどうかご確認ください。" End With elmMenu.appendChild elmButton Set elmButton = Nothing Else i = 1: j = 1 '初期化 ff = FreeFile Open DataFilePath For Input As #ff Do Until EOF(ff) Line Input #ff, buf If Len(buf) > 0 Then v = Split(buf, ";") 'Debug.Print "AddInName:" & v(0), "Caption:" & v(1), "MacroName:" & v(2) If j > 9 Then j = 1 Set elmButton = d.createElement("button") With elmButton .setAttribute "id", BtnID & CStr(i) .setAttribute "label", v(1) & "(" & ChrW(38) & CStr(j) & ")" .setAttribute "imageMso", "MacroRun" .setAttribute "screentip", "アドイン名:" & v(0) .setAttribute "supertip", "マクロ名:" & v(2) .setAttribute "tag", v(0) & "|" & v(2) .setAttribute "onAction", BtnID & "_onAction" End With elmMenu.appendChild elmButton Set elmButton = Nothing i = i + 1 j = j + 1 End If Loop Close #ff End If d.appendChild elmMenu returnedVal = d.XML End Sub Public Sub btnCallProc_onAction(control As IRibbonControl) Dim v As Variant On Error Resume Next v = Split(control.Tag, "|") Application.Run v(0) & "!" & v(1) If Err.Number <> 0 Then MsgBox "エラーが発生しました。" & vbCrLf & vbCrLf & _ "エラーNo:" & Err.Number & vbCrLf & _ "エラー情報:" & Err.Description, vbCritical + vbSystemModal Err.Clear End If On Error GoTo 0 End Sub
久しぶりに引っ張り出してきたファイルなので、上記コードが最新版かどうかは分かりませんが(^^; 、基本的な仕組みは変わっていないはずです。
dynamicMenu要素のgetContent属性のコールバックで動的にXMLを読み込んで、テキストファイルに記述されたマクロを実行する形ですね。
この記事へのコメントはありません。