カスタム検索
リボン関連

 

トップページ > リボン関連 > リボン上のメニューからテンプレートを選択する(Word)

 

Sponsored Links

リボン上のメニューからテンプレートを選択する(Word)

「メニューの内容を動的に変更する」の応用で、今回はリボン上のメニューからテンプレートを選択する方法を紹介します。

 

[標準モジュール]

Option Explicit

Private SubMenuNum As Long
Private SubButtonNum As Long

Public Sub button_onAction(control As IRibbonControl)
  On Error Resume Next
  Application.Documents.Add Template:=control.Tag
End Sub

Public Sub dynamicMenu_getContent(control As IRibbonControl, ByRef returnedVal)
  Dim d As Object
  Dim elmMenu As Object
  
  '初期化
  SubMenuNum = 0
  SubButtonNum = 0
  
  Set d = CreateObject("Msxml2.DOMDocument")
  Set elmMenu = d.createElement("menu")
  elmMenu.setAttribute "xmlns", "http://schemas.microsoft.com/office/2006/01/customui"
  elmMenu.setAttribute "itemSize", "large"
  
  CreateMenu Application.Options.DefaultFilePath(wdUserTemplatesPath), elmMenu
  returnedVal = elmMenu.XML
End Sub

Private Sub CreateMenu(ByVal FolderPath As Variant, ByRef elmMenu As Object)
'menu用XML作成
  Dim ShellDisp As Object
  Dim Shell As Object
  Dim Fso As Object
  Dim itm As Object
  Dim elmSubMenu As Object
  Dim elmSubButton As Object
  Dim d As Object
  
  'メニューのネスト上限に達したら処理中止
  If CountPathDelimiter(FolderPath) - CountPathDelimiter(Application.Options.DefaultFilePath(wdUserTemplatesPath)) >= 4 Then Exit Sub
  
  Set ShellDisp = CreateObject("Shell.Application")
  Set Shell = CreateObject("WScript.Shell")
  Set Fso = CreateObject("Scripting.FileSystemObject")
  Set d = CreateObject("Msxml2.DOMDocument")
  
  SubMenuNum = SubMenuNum + 1
  Set elmSubMenu = d.createElement("menu")
  elmSubMenu.setAttribute "id", "mySubMenu" & SubMenuNum
  elmSubMenu.setAttribute "label", GetFolderName(FolderPath)
  elmSubMenu.setAttribute "imageMso", "HeaderFooterFilePathInsert"
  
  For Each itm In ShellDisp.NameSpace(FolderPath).Items
    If itm.IsLink Then
      If Fso.FolderExists(Shell.CreateShortcut(itm.Path).TargetPath) Then
        CreateMenu Shell.CreateShortcut(itm.Path).TargetPath, elmSubMenu
      Else
        If IsWordFile(Shell.CreateShortcut(itm.Path).TargetPath) Then
          SubButtonNum = SubButtonNum + 1
          Set elmSubButton = d.createElement("button")
          elmSubButton.setAttribute "id", "mySubButton" & SubButtonNum
          elmSubButton.setAttribute "label", GetFileName(Shell.CreateShortcut(itm.Path).TargetPath)
          elmSubButton.setAttribute "supertip", Shell.CreateShortcut(itm.Path).TargetPath
          elmSubButton.setAttribute "imageMso", "FileSaveAsWordDocx"
          elmSubButton.setAttribute "tag", Shell.CreateShortcut(itm.Path).TargetPath
          elmSubButton.setAttribute "onAction", "button_onAction"
          elmSubMenu.appendChild elmSubButton
        End If
      End If
    ElseIf itm.IsFolder Then
      CreateMenu itm.Path, elmSubMenu
    Else
      If IsWordFile(itm.Path) Then
        SubButtonNum = SubButtonNum + 1
        Set elmSubButton = d.createElement("button")
        elmSubButton.setAttribute "id", "mySubButton" & SubButtonNum
        elmSubButton.setAttribute "label", itm.Name
        elmSubButton.setAttribute "supertip", itm.Path
        elmSubButton.setAttribute "imageMso", "FileSaveAsWordDocx"
        elmSubButton.setAttribute "tag", itm.Path
        elmSubButton.setAttribute "onAction", "button_onAction"
        elmSubMenu.appendChild elmSubButton
      End If
    End If
  Next
  elmMenu.appendChild elmSubMenu
  
  Set d = Nothing
  Set Fso = Nothing
  Set Shell = Nothing
  Set ShellDisp = Nothing
End Sub

Private Function IsWordFile(ByVal FilePath As String) As Boolean
'Wordファイル判別
  Dim ret As Boolean
  
  ret = False '初期化
  With CreateObject("Scripting.FileSystemObject")
    Select Case LCase$(.GetExtensionName(FilePath))
      Case "doc", "dot", "docx", "docm", "dotx", "dotm"
        ret = True
    End Select
  End With
  IsWordFile = ret
End Function

Private Function GetFolderName(ByVal FolderPath As String) As String
'フォルダ名取得
  GetFolderName = CreateObject("Scripting.FileSystemObject").GetFolder(FolderPath).Name
End Function

Private Function GetFileName(ByVal FilePath As String) As String
'ファイル名取得
  GetFileName = CreateObject("Scripting.FileSystemObject").GetFile(FilePath).Name
End Function

Private Function CountPathDelimiter(ByVal FolderPath As String) As Long
'パス区切り記号カウント
  Dim v As Variant
  
  v = Split(FolderPath, ChrW(&H5C))
  CountPathDelimiter = UBound(v)
End Function

 

※ リボンXMLの編集方法については「Office Ribbon Editorの紹介」「SharpDevelopでリボンXMLを編集する」等のページを参照してください。

 

[リボンXML]

<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <ribbon>
    <tabs>
      <tab idMso="TabHome">
        <group id="grpSelectTemplate" label="テンプレート選択メニュー" insertBeforeMso="GroupClipboard">
          <dynamicMenu id="dnuSelectTemplate" label="テンプレート選択" imageMso="BlankPageInsert" size="large" getContent="dynamicMenu_getContent" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

 

Sponsored Links

 

上記のコードではWordのテンプレートフォルダ(サブフォルダ含む)内にあるWordファイルを取得して、リボン上のメニューから開けるようにしています。

※ 上記コードをテンプレート化したものがコチラ

 

関連記事

・ メニューの内容を動的に変更する
・ 外部のXMLファイルを読み込み、ユーザー名に応じてmenu内容を変更する
・ menu内にあるbuttonの数を増やす
・ リボンからプリンタを選択して簡単に印刷できるようにする(Word)

トップページ > リボン関連 > リボン上のメニューからテンプレートを選択する(Word)