Office関連

「クイックアクセスツールバーからPowerPointマクロを実行するアドイン」のコード

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

[雑感]Office 365 Soloに向く人、向かない人前のページ

Officeの新製品発売記念イベントに参加してきました。次のページ

関連記事

  1. Office関連

    「いちばんやさしいPowerPoint VBAの教本」レビュー

    「インストラクターのネタ帳」で有名な伊藤さんが執筆された書籍第二弾、「…

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(J)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. Office アドイン

    [Officeアドイン]枠線(目盛線)の表示・非表示を切り替える方法

    ここ二週間ほど体調を崩していたので久しぶりのブログ更新です。久…

  4. Office関連

    Office 365 unified APIをJavaScriptだけで呼び出す

    Microsoftの松崎さんのブログに下記の記事がありました。…

  5. アイコン一覧

    Office 2013 アイコン一覧(U)

    ・Office 2013 アイコン一覧 NUM…

コメント

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

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP