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を読み込んで、テキストファイルに記述されたマクロを実行する形ですね。



















この記事へのコメントはありません。