マクロに割り当てたショートカットキーをCSVファイルとして出力するWordマクロ

ホーム
Office関連, Word
マクロに割り当てたショートカットキーをCSVファイルとして出力するWordマクロ

2012.01.30

マクロに割り当てたショートカットキーをCSVファイルとして出力するWordマクロ

Word MVPの新田さんが書かれた以下の記事を見て思いついたマクロです。

・ユーザー登録をしたキーボードのショートカットを書き出すマクロ
・ユーザー登録をしたキーボードのショートカットを書き出すマクロ（その２）
・ユーザー登録をしたキーボードのショートカットを印刷する方法

下記「OutPutKeyBindings」を実行すると、標準テンプレート含めたテンプレートファイル(有効になっているもののみ)に登録されているキー定義一覧をCSVファイルとしてデスクトップに出力します。

Option Explicit
 
Public Sub OutPutKeyBindings()
'キー定義出力
  Dim OutputFilePath As String
  Dim tp As Word.Template
  Dim tmp As Word.Template
  Dim kb As Word.KeyBinding
  Dim ff As Integer
   
  '出力先ファイル準備(デスクトップにCSVファイルとして出力)
  OutputFilePath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
                   Application.PathSeparator & "WordKeyBindings.csv"
  ff = FreeFile
  Open OutputFilePath For Output As #ff
  Print #ff, "テンプレート名,テンプレートのパス,コマンド,キーコード,キーの組み合わせ"
     
  Set tmp = Application.CustomizationContext '現在の保存先テンプレート取得
  '標準テンプレート
  Application.CustomizationContext = NormalTemplate
  For Each kb In Application.KeyBindings
    Print #ff, "標準テンプレート(" & NormalTemplate.Name & ")," & _
               NormalTemplate.FullName & "," & _
               kb.Command & "," & _
               kb.KeyCode & "," & _
               kb.KeyString
  Next
   
  '標準テンプレート以外
  For Each tp In Application.Templates
    If tp.FullName <> NormalTemplate.FullName Then
      If IsInstalledTemplate(tp) = True Then
        Application.CustomizationContext = tp
        For Each kb In Application.KeyBindings
           Print #ff, tp.Name & "," & _
                      tp.FullName & "," & _
                      kb.Command & "," & _
                      kb.KeyCode & "," & _
                      kb.KeyString
        Next
      End If
    End If
  Next
   
  Application.CustomizationContext = tmp '保存先テンプレートを元に戻す
  Set tmp = Nothing
  Close #ff
  MsgBox "処理が終了しました。" & vbCrLf & vbCrLf & _
         "[" & OutputFilePath & "]" & vbCrLf & vbCrLf & _
         "にキー定義一覧が出力されました。", vbInformation + vbSystemModal
End Sub
 
Private Function IsInstalledTemplate(ByVal tp As Word.Template) As Boolean
'テンプレートが有効になっているかどうかを判断
  Dim ad As Word.AddIn
  Dim ret As Boolean
   
  ret = False '初期化
  '標準テンプレートであればTrue
  If tp.FullName = NormalTemplate.FullName Then
    ret = True
  Else
    On Error Resume Next
    Set ad = Application.AddIns(tp.FullName)
    On Error GoTo 0
    If Not ad Is Nothing Then
      'Wordアドインライブラリ(WLL)ではない = テンプレートの場合のみ処理
      If ad.Compiled = False Then
        If ad.Installed = True Then
          ret = True
        End If
      End If
      Set ad = Nothing
    End If
  End If
  IsInstalledTemplate = ret
End Function