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関連

    KB2553154の更新プログラムをアンインストールするVBScript

    2014/12/11 追記:当記事で紹介しているのは更新プログラム…

  2. Office関連

    Excel 2013版URLエンコードマクロ

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  3. アイコン一覧

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

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

  4. アイコン一覧

    Office 2013 アイコン一覧(N)

    ・Office 2013 アイコン一覧 NUM…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP