カスタム検索
Office関連

 

トップページ > Office関連 > Wordマクロ備忘録(Word VBA)

 

Sponsored Links

Wordマクロ備忘録(Word VBA)

ここではWordマクロの小技をメモ書き程度に紹介していきます。

 

 

デスクトップ上のアイコンを非表示にする

デスクトップ上のアイコンを非表示にします。
「WM_SHOWWINDOW Message」参照。

Public Sub Sample()
  Application.Tasks("Program Manager").SendWindowMessage &H18, False, 1&
End Sub

元に戻すときは「Application.Tasks("Program Manager").SendWindowMessage &H18, True, 3&」を実行。

 

Word上のマウスポインタを？マーク付きにする

Word上のマウスポインタを？マーク付きに変更します。
変更後、適当な場所をクリックすると元に戻ります。

Public Sub Sample()
  Application.Tasks("Microsoft Word").SendWindowMessage &H112, &HF180&, 0&
End Sub

 

スタートメニューを表示する

スタートメニューを表示します。

Public Sub Sample()
  Application.Tasks("Program Manager").SendWindowMessage &H112, &HF130&, 0&
End Sub

 

スクリーンセーバーを起動する

スクリーンセーバーを起動します。
スクリーンセーバーが設定されていない場合は動作しません。

Public Sub Sample()
  Application.Tasks("Program Manager").SendWindowMessage &H112, &HF140&, 0&
End Sub

 

Wordのウィンドウを移動できるようにする

下記コード実行後、マウスカーソルを動かすとWordのウィンドウを移動することができるようになります(適当な場所でクリックすると移動停止)。

Public Sub Sample()
  Application.Tasks("Microsoft Word").SendWindowMessage &H112, &HF000& Or 9&, 0&
End Sub

 

組込みドキュメントプロパティを列挙する

文書の組込みプロパティを列挙します。
「WdBuiltInProperty Enumeration」参照。

Public Sub Sample()
  On Error Resume Next
  With ActiveDocument
    Debug.Print "1.Title. - " & .BuiltInDocumentProperties(wdPropertyTitle)
    Debug.Print "2.Subject. - " & .BuiltInDocumentProperties(wdPropertySubject)
    Debug.Print "3.Author. - " & .BuiltInDocumentProperties(wdPropertyAuthor)
    Debug.Print "4.Keywords. - " & .BuiltInDocumentProperties(wdPropertyKeywords)
    Debug.Print "5.Comments. - " & .BuiltInDocumentProperties(wdPropertyComments)
    Debug.Print "6.Template name. - " & .BuiltInDocumentProperties(wdPropertyTemplate)
    Debug.Print "7.Last author. - " & .BuiltInDocumentProperties(wdPropertyLastAuthor)
    Debug.Print "8.Revision number. - " & .BuiltInDocumentProperties(wdPropertyRevision)
    Debug.Print "9.Name of application. - " & .BuiltInDocumentProperties(wdPropertyAppName)
    Debug.Print "10.Time last printed. - " & .BuiltInDocumentProperties(wdPropertyTimeLastPrinted)
    Debug.Print "11.Time created. - " & .BuiltInDocumentProperties(wdPropertyTimeCreated)
    Debug.Print "12.Time last saved. - " & .BuiltInDocumentProperties(wdPropertyTimeLastSaved)
    Debug.Print "13.Number of edits to VBA project. - " & .BuiltInDocumentProperties(wdPropertyVBATotalEdit)
    Debug.Print "14.Page count. - " & .BuiltInDocumentProperties(wdPropertyPages)
    Debug.Print "15.Word count. - " & .BuiltInDocumentProperties(wdPropertyWords)
    Debug.Print "16.Character count. - " & .BuiltInDocumentProperties(wdPropertyCharacters)
    Debug.Print "17.Security setting. - " & .BuiltInDocumentProperties(wdPropertySecurity)
    Debug.Print "18.Category. - " & .BuiltInDocumentProperties(wdPropertyCategory)
    Debug.Print "19.Not supported. - " & .BuiltInDocumentProperties(wdPropertyFormat)
    Debug.Print "20.Manager. - " & .BuiltInDocumentProperties(wdPropertyManager)
    Debug.Print "21.Company. - " & .BuiltInDocumentProperties(wdPropertyCompany)
    Debug.Print "22.Byte count. - " & .BuiltInDocumentProperties(wdPropertyBytes)
    Debug.Print "23.Line count. - " & .BuiltInDocumentProperties(wdPropertyLines)
    Debug.Print "24.Paragraph count. - " & .BuiltInDocumentProperties(wdPropertyParas)
    Debug.Print "25.Not supported. - " & .BuiltInDocumentProperties(wdPropertySlides)
    Debug.Print "26.Notes. - " & .BuiltInDocumentProperties(wdPropertyNotes)
    Debug.Print "27.Not supported. - " & .BuiltInDocumentProperties(wdPropertyHiddenSlides)
    Debug.Print "28.Not supported. - " & .BuiltInDocumentProperties(wdPropertyMMClips)
    Debug.Print "29.Not supported. - " & .BuiltInDocumentProperties(wdPropertyHyperlinkBase)
    Debug.Print "30.Character count with spaces. - " & .BuiltInDocumentProperties(wdPropertyCharsWSpaces)
  End With
  On Error GoTo 0
End Sub

 

組込みドキュメントプロパティを列挙する(2)

文書の組込みプロパティを列挙します。

Public Sub Sample()
'BuiltInDocumentProperty列挙
  Dim dp As Office.DocumentProperty
  
  Debug.Print "*-----*-----*-----*-----*-----*"
  Debug.Print "BuiltInDocumentProperties"
  Debug.Print "*-----*-----*-----*-----*-----*"
  On Error Resume Next
  For Each dp In ActiveDocument.BuiltInDocumentProperties
    Debug.Print dp.Name, dp.Value, dp.Type
  Next
  On Error GoTo 0
  Debug.Print "*-----*-----*-----*-----*-----*"
End Sub

 

検索してヒットした文字列を蛍光ペンでマークする

指定した文字列を文書内で検索し、ヒットしたら蛍光ペンでマークします。

Sub Sample()
  Dim r As Word.Range
  Const SearchTerm As String = "検索語"
  
  Set r = ActiveDocument.Range(0, 0)
  With r.Find
    .ClearFormatting
    '検索のパラメータは適宜変更
    Do While .Execute(FindText:=SearchTerm, MatchWildcards:=True, Forward:=True)
      r.HighlightColorIndex = wdYellow
    Loop
  End With
  Set r = Nothing
End Sub

 

独自の右クリックメニューを追加する

独自の右クリックメニューを追加して、そこから既存のコマンドやマクロを実行します。

Public Sub Sample()
  Const MenuCaption As String = "オリジナル右クリックメニュー"
  
  On Error Resume Next
  Application.CommandBars("Text").Controls(MenuCaption).Delete
  On Error GoTo 0
  With Application.CommandBars("Text").Controls.Add(Type:=msoControlPopup, Before:=1, Temporary:=True)
    .Caption = MenuCaption
    .Controls.Add ID:=792 '文字カウント
    With .Controls.Add(Type:=msoControlButton)
      .Caption = "My Menu"
      .FaceId = 59
      .OnAction = "MenuProc"
      .Tag = "これはオリジナルメニューです。"
    End With
  End With
End Sub

Public Sub MenuProc()
  With Application.CommandBars.ActionControl
    MsgBox "Caption : " & .Caption & vbCrLf & "Tag : " & .Tag
  End With
End Sub

 

変更履歴の情報を列挙する

変更履歴のページ番号や行、タイプ等を列挙します。

Public Sub Sample()
  Dim rv As Word.Revision
  
  For Each rv In ActiveDocument.Revisions
    Debug.Print "ページ：" & rv.Range.Information(wdActiveEndAdjustedPageNumber), _
                "行：" & rv.Range.Information(wdFirstCharacterLineNumber), _
                "タイプ：" & rv.Type, _
                "テキスト：" & rv.Range.Text
  Next
End Sub

 

キャレット位置の情報を取得する

キャレット位置の各種情報を取得します。
「Information プロパティ」「[W_WD98] カーソル位置の情報を取得する方法」参照。

Public Sub Sample()
  On Error Resume Next
  Debug.Print "ページ番号(手動で変更したページ番号を反映)：", Selection.Information(wdActiveEndAdjustedPageNumber)
  Debug.Print "セクション番号：", Selection.Information(wdActiveEndSectionNumber)
  Debug.Print "ページ番号：", Selection.Information(wdActiveEndPageNumber)
  Debug.Print "ページ数：", Selection.Information(wdNumberOfPagesInDocument)
  Debug.Print "用紙の水平位置：", Selection.Information(wdHorizontalPositionRelativeToPage)
  Debug.Print "用紙の垂直位置：", Selection.Information(wdVerticalPositionRelativeToPage)
  Debug.Print "文書領域の水平位置：", Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
  Debug.Print "文書領域の垂直位置：", Selection.Information(wdVerticalPositionRelativeToTextBoundary)
  Debug.Print "文字位置：", Selection.Information(wdFirstCharacterColumnNumber)
  Debug.Print "行数：", Selection.Information(wdFirstCharacterLineNumber)
  Debug.Print "レイアウト枠またはテキスト ボックス全体：", Selection.Information(wdFrameIsSelected)
  Debug.Print "表：", Selection.Information(wdWithInTable)
  Debug.Print "選択範囲の先頭位置の行番号：", Selection.Information(wdStartOfRangeRowNumber)
  Debug.Print "選択範囲の終了位置の行番号：", Selection.Information(wdEndOfRangeRowNumber)
  Debug.Print "最大行数：", Selection.Information(wdMaximumNumberOfRows)
  Debug.Print "選択範囲の先頭位置の列番号：", Selection.Information(wdStartOfRangeColumnNumber)
  Debug.Print "選択範囲の終了位置の列番号：", Selection.Information(wdEndOfRangeColumnNumber)
  Debug.Print "最大列数：", Selection.Information(wdMaximumNumberOfColumns)
  Debug.Print "現在の倍率：", Selection.Information(wdZoomPercentage)
  Debug.Print "選択モードの状態：", Selection.Information(wdSelectionMode)
  Debug.Print "CapsLockキーのオン/オフ：", Selection.Information(wdCapsLock)
  Debug.Print "NumLockキーのオン/オフ：", Selection.Information(wdNumLock)
  Debug.Print "上書きモードのオン/オフ：", Selection.Information(wdOverType)
  Debug.Print "変更履歴作成のオン/オフ：", Selection.Information(wdRevisionMarking)
  Debug.Print "脚注/文末脚注の領域またはウィンドウ枠：", Selection.Information(wdInFootnoteEndnotePane)
  Debug.Print "コメントウィンドウ枠：", Selection.Information(wdInCommentPane)
  Debug.Print "ヘッダー/フッターの領域またはウィンドウ枠：", Selection.Information(wdInHeaderFooter)
  Debug.Print "表の区切り記号が含まれているか判断：", Selection.Information(wdAtEndOfRowMarker)
  Debug.Print "脚注、文末脚注、またはコメントの参照範囲：", Selection.Information(wdReferenceOfType)
  Debug.Print "ヘッダーまたはフッターの種類：", Selection.Information(wdHeaderFooterType)
  Debug.Print "グループ文書：", Selection.Information(wdInMasterDocument)
  Debug.Print "脚注領域または脚注ウィンドウ枠：", Selection.Information(wdInFootnote)
  Debug.Print "文末脚注領域または文末脚注ウィンドウ枠：", Selection.Information(wdInEndnote)
  Debug.Print "WordMail：", Selection.Information(wdInWordMail)
  Debug.Print "Clipboard：", Selection.Information(wdInClipboard) 'Microsoft Office Macintosh Edition Language Reference 参照
  On Error GoTo 0
End Sub

 

組込みダイアログを表示する

Wordの組込みダイアログを表示します。
「Word のダイアログ ボックスを使用する」参照。

Public Sub Sample()
  Application.Dialogs(wdDialogFileSaveAs).Show
End Sub

 

値を設定した状態で組込みダイアログを表示する

ダイアログで設定できる値を事前に設定した状態で組込みダイアログを表示します。
「WdWordDialog Enumeration」「Word の組み込みのダイアログ ボックスを表示する」参照。

Public Sub Sample()
  With Application.Dialogs(wdDialogFileSaveAs)
    .Name = "MyFile"
    .Format = wdFormatText
    .Show
  End With
End Sub

 

組込みダイアログを表示させずに処理を実行する

組込みダイアログを表示させずにダイアログから処理を実行します。
「WdWordDialog Enumeration」「Word の組み込みのダイアログ ボックスを表示する」参照。

Public Sub Sample()
  With Application.Dialogs(wdDialogFileSaveAs)
    .Name = "D:\TestFiles\MyFile.txt"
    .Format = wdFormatText
    .Execute
  End With
End Sub

 

マクロにショートカットキーを設定する

マクロにショートカットキーを設定します。

Public Sub Sample()
  Const MacroName As String = "MyProc"
  
  'キーの設定先：ThisDocument
  Application.CustomizationContext = ThisDocument
  'Ctrl + Shift + N キーにマクロを設定
  Application.KeyBindings.Add KeyCategory:=wdKeyCategoryCommand, _
                              Command:=MacroName, _
                              KeyCode:=BuildKeyCode(wdKeyControl, wdKeyShift, wdKeyN)
End Sub

Public Sub MyProc()
  MsgBox "Hello!"
End Sub

 

マクロに設定したショートカットキーを無効にする

指定したキーの組合わせにマクロが割り当てられているかどうかを確認し、割り当てられている場合はキーの組合わせを削除します。

Public Sub Sample()
  Const MacroName As String = "MyProc"
  
  'キーの設定先：ThisDocument
  Application.CustomizationContext = ThisDocument
  'Ctrl + Shift + N キーに設定されたコマンド(マクロ)を無効にする
  With Application.FindKey(Application.BuildKeyCode(wdKeyControl, wdKeyShift, wdKeyN))
    If InStr(.Command, MacroName) Then .Disable: .Clear
  End With
End Sub

 

キー割り当てに関する情報を列挙する

ユーザー設定のキーの割り当てに関する情報を列挙します。

Public Sub Sample()
  Dim kb As Word.KeyBinding
  
  'キーの設定先：NormalTemplate
  Application.CustomizationContext = NormalTemplate
  For Each kb In Application.KeyBindings
    Debug.Print "コマンド：" & kb.Command, "キーの組み合わせ：" & kb.KeyString
  Next
End Sub

 

マクロやツールバーを削除する

マクロやツールバーを削除します(スタイルや定型句も削除可能)。

Public Sub Sample()
  On Error Resume Next
  'ActiveDocumentにある「Module1」を削除する
  Application.OrganizerDelete ActiveDocument.Name, "Module1", wdOrganizerObjectProjectItems
  'NormalTemplateにある「MyCommandBar」を削除する
  Application.OrganizerDelete NormalTemplate.Name, "MyCommandBar", wdOrganizerObjectCommandBars
  On Error GoTo 0
End Sub

 

ファイルを開いたときにマクロを実行する

ファイルを開いた時にマクロを実行する方法はいくつかあり、下記例の場合だと 1. AutoOpen、2. Document_Open、3. Ribbon_onLoad(customUI要素のonLoad属性のコールバック(Office 2007以降のみ)) の順でマクロが実行されます。

'ThisDocument
Private Sub Document_Open()
  MsgBox "Document_Open"
End Sub

'標準モジュール
Public Sub AutoOpen()
  MsgBox "AutoOpen"
End Sub

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)
  MsgBox "Ribbon_onLoad"
End Sub

'customUI
<?xml version="1.0" encoding="utf-8"?>
<customUI onLoad="Ribbon_onLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui" />

 

指定したページに移動する

GoToメソッドを使うことによって文書内の指定した位置に移動することができます。

Public Sub Sample()
  '5ページ目の先頭に移動
  Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=5
End Sub

 

キャレット位置に文字列を挿入する

選択範囲がカーソル位置である場合に文字列を挿入します。

Public Sub Sample()
  If Selection.Type = wdSelectionIP Then
    Selection.TypeText "こんにちは。"
    Selection.TypeParagraph
    Selection.TypeText "今日は良い天気ですね！"
  End If
End Sub

 

Excelを利用してフリガナを取得する

ExcelのGetPhoneticメソッドを利用してフリガナを取得します。

Public Sub Sample()
  'ExcelのGetPhoneticメソッドを利用してフリガナを取得
  MsgBox GetPhoneticExcel("東京都千代田区千代田1番1号")
End Sub

Private Function GetPhoneticExcel(ByVal sTarget As String) As String
  Dim ret As String
  
  ret = "" '初期化
  On Error Resume Next
  With CreateObject("Excel.Application")
    .Visible = False
    ret = .GetPhonetic(sTarget)
    .Quit
  End With
  On Error GoTo 0
  
  GetPhoneticExcel = ret
End Function

 

保護されたビューでファイルを開く(Word 2010以降)

Office 2010からの新機能、保護されたビューでファイルを開きます。

Public Sub Sample()
  Application.ProtectedViewWindows.Open FileName:="C:\Test\MyFile.docx", PasswordDocument:="pass"
End Sub

 

互換モードでファイルが開かれているかどうかを確認する(Word 2010以降)

互換モードでファイルが開かれているかどうかを確認します。

Public Sub Sample()
  Select Case ActiveDocument.CompatibilityMode
    Case wdWord2003: MsgBox "Word 2003 互換モードでファイルを開いています。"
    Case wdWord2007: MsgBox "Word 2007 互換モードでファイルを開いています。"
    Case wdWord2010: MsgBox "Word 2010 互換モードでファイルを開いています。"
    Case wdCurrent: MsgBox "最新バージョン互換モードでファイルを開いています。"
    Case Else: MsgBox "不明です。"
  End Select
End Sub

 

開いている文書に互換モードを設定する(Word 2010以降)

開いている文書に互換モードを設定します。

Public Sub Sample()
  'Word 2003 互換モードに設定
  ActiveDocument.SetCompatibilityMode wdWord2003
End Sub

 

SaveAs2メソッドでファイルを保存する(Word 2010以降)

Word 2010で追加されたSaveAs2メソッドでファイルを保存します。
従来のSaveAsメソッドは非表示メンバになっただけで、削除されたわけではありません。

Public Sub Sample()
  'Word 2003 互換モードで保存
  ActiveDocument.SaveAs2 FileName:="C:\Test\MyFile.docm", CompatibilityMode:=wdWord2003
End Sub

 

指定したフォントが使われているかどうかをチェックする

指定したフォント名が使われているかどうかを1文字ずつチェックします。
下記のコードではSymbolフォントをチェックして、ヒットしたら蛍光ペンでマークします。

Public Sub Sample()
  Dim r As Word.Range
  Const FontName As String = "Symbol"
  
  Application.ScreenUpdating = False
  For Each r In ActiveDocument.Characters
    If ChkFont(r, FontName) Then
      r.HighlightColorIndex = wdYellow
    End If
  Next
  Selection.HomeKey unit:=wdStory
  Application.ScreenUpdating = True
End Sub

Private Function ChkFont(ByVal rTarget As Word.Range, ByVal sFontName As String) As Boolean
  Dim ret As Boolean
  Dim dlg As Word.Dialog
  
  ret = False '初期化
  rTarget.Select
  Set dlg = Application.Dialogs(wdDialogFormatFont)
  If Selection.Font.Name = sFontName Then
    ret = True
  ElseIf Selection.Font.NameAscii = sFontName Then
    ret = True
  ElseIf Selection.Font.NameBi = sFontName Then
    ret = True
  ElseIf Selection.Font.NameFarEast = sFontName Then
    ret = True
  ElseIf Selection.Font.NameOther = sFontName Then
    ret = True
  ElseIf dlg.Font = sFontName Then
    ret = True
  ElseIf dlg.FontHighAnsi = sFontName Then
    ret = True
  ElseIf dlg.FontLowAnsi = sFontName Then
    ret = True
  ElseIf dlg.FontNameBi = sFontName Then
    ret = True
  ElseIf Application.Dialogs(wdDialogInsertSymbol).Font = sFontName Then
    ret = True
  End If
  Set dlg = Nothing
  
  ChkFont = ret
End Function

 

リサーチサービスを利用して文章を翻訳する

下記コードでは選択文字列を翻訳するマクロを右クリックメニューに追加します。
Office 2010以前の環境でMicrosoft Translatorを利用する場合は「MicrosoftTranslatorInstallerForOffice.exe」をインストールする必要があります。
※ コード内のGUIDは「HKEY_CURRENT_USER\Software\Microsoft\Office\(Version)\Common\Research\Sources」参照。

Public Sub Sample()
  Const MenuCaption As String = "選択文字列を翻訳"
  
  On Error Resume Next
  Application.CommandBars("Text").Controls(MenuCaption).Delete
  On Error GoTo 0
  
  With Application.CommandBars("Text").Controls.Add(Type:=msoControlPopup, Temporary:=True)
    .Caption = MenuCaption
    With .Controls.Add(Type:=msoControlButton, Temporary:=True)
      .Caption = "日本語 - 英語 (文章)(Microsoft Translator)"
      .FaceId = 7685
      .OnAction = "TranslateSelText"
      .Parameter = 1041
      .Tag = "{0297CD20-047F-4256-1104-000009040000}"
    End With
    
    With .Controls.Add(Type:=msoControlButton, Temporary:=True)
      .Caption = "英語 - 日本語 (文章)(Microsoft Translator)"
      .FaceId = 7685
      .OnAction = "TranslateSelText"
      .Parameter = 1033
      .Tag = "{0297CD20-047F-4256-0904-000011040000}"
    End With
    
    With .Controls.Add(Type:=msoControlButton, Temporary:=True)
      .Caption = "日本語から中国語簡体(WorldLingo)"
      .FaceId = 7685
      .OnAction = "TranslateSelText"
      .Parameter = 1041
      .Tag = "{6D7843CD-6430-44F5-AB06-8ADDD40EDDF5}"
    End With
    
    With .Controls.Add(Type:=msoControlButton, Temporary:=True)
      .Caption = "日本語から中国語繁体(WorldLingo)"
      .FaceId = 7685
      .OnAction = "TranslateSelText"
      .Parameter = 1041
      .Tag = "{F57F5F56-A83E-4811-8DEB-93291052B019}"
    End With
    
    With .Controls.Add(Type:=msoControlButton, Temporary:=True)
      .Caption = "日本語から韓国/朝鮮語(WorldLingo)"
      .FaceId = 7685
      .OnAction = "TranslateSelText"
      .Parameter = 1041
      .Tag = "{C4F73B16-7627-4DAD-A03D-6DA38CB695EC}"
    End With
  End With
End Sub

Private Sub TranslateSelText()
'リサーチサービスで選択文字列を翻訳
  Dim GUID As String
  Dim QL As Long
  
  If Selection.Type <> wdSelectionNormal Then Exit Sub
  GUID = Application.CommandBars.ActionControl.Tag
  QL = Application.CommandBars.ActionControl.Parameter
  With ActiveDocument.Research
    If .IsResearchService(GUID) Then .Query ServiceID:=GUID, QueryLanguage:=QL, UseSelection:=True
  End With
End Sub

 

ファイルコンバータの情報を列挙する

ファイルコンバータの情報(コンバータ名、拡張子等)を列挙します。

Public Sub Sample()
  Dim fc As Word.FileConverter
  
  For Each fc In Application.FileConverters
    Debug.Print "コンバータ名：" & fc.FormatName, _
                "名前：" & fc.Name, _
                "クラス名：" & fc.ClassName, _
                "拡張子：" & fc.Extensions, _
                "パス：" & fc.Path
  Next
End Sub

 

使用可能なフォント名を列挙する

使用可能なフォント名を列挙します。

Public Sub Sample()
  Dim f As Variant
  
  For Each f In Application.FontNames
    If MsgBox(CStr(f), vbOKCancel) = vbCancel Then Exit For
  Next
End Sub

 

マウスが使用可能かどうかを判断する

マウスが使用可能な状態かどうかを判断します。

Public Sub Sample()
  If Application.MouseAvailable Then
    MsgBox "マウスは使用可能な状態です。", vbInformation
  Else
    MsgBox "現在マウスは使用できません。", vbCritical
  End If
End Sub

 

最近使用したドキュメントをクリアする

RecentFilesコレクションを利用して最近使用したドキュメントをクリアします。

Public Sub Sample()
  Dim tmp As Long
  
  tmp = Application.RecentFiles.Maximum
  Application.RecentFiles.Maximum = 0
  Application.RecentFiles.Maximum = tmp
End Sub

Public Sub Sample2()
  Dim rf As Word.RecentFile
  
  For Each rf In Application.RecentFiles
    rf.Delete
  Next
End Sub

 

スタートアップフォルダの場所を取得する

スタートアップフォルダの場所を取得します。

Public Sub Sample()
  MsgBox Application.StartupPath
End Sub

 

PowerPointに文書を送信する

PowerPointで指定したドキュメントを開きます。

Public Sub Sample()
  ActiveDocument.PresentIt
End Sub

 

起動中のアプリケーションを終了しログオフする

起動しているすべてのアプリケーションを終了し、ログオフします。

Public Sub Sample()
  Application.Documents.Save True '作業中の文書を保存
  Application.Tasks.ExitWindows
End Sub

 

Wordに関連付けられたファイルの既定のフォルダを列挙する

Wordに関連付けられたファイルの既定のフォルダ(ユーザー テンプレートのパス他)を列挙します。

Public Sub Sample()
  Debug.Print "文書のパス：" & Application.Options.DefaultFilePath(wdDocumentsPath)
  Debug.Print "図のパス：" & Application.Options.DefaultFilePath(wdPicturesPath)
  Debug.Print "ユーザー テンプレートのパス：" & Application.Options.DefaultFilePath(wdUserTemplatesPath)
  Debug.Print "ワークグループ テンプレートのパス：" & Application.Options.DefaultFilePath(wdWorkgroupTemplatesPath)
  Debug.Print "ユーザー オプションのパス：" & Application.Options.DefaultFilePath(wdUserOptionsPath)
  Debug.Print "自動バックアップ ファイルのパス：" & Application.Options.DefaultFilePath(wdAutoRecoverPath)
  Debug.Print "ツールのパス：" & Application.Options.DefaultFilePath(wdToolsPath)
  Debug.Print "学習ソフトウェアのパス：" & Application.Options.DefaultFilePath(wdTutorialPath)
  Debug.Print "スタートアップのパス：" & Application.Options.DefaultFilePath(wdStartupPath)
  Debug.Print "プログラムのパス：" & Application.Options.DefaultFilePath(wdProgramPath)
  Debug.Print "グラフィック フィルタのパス：" & Application.Options.DefaultFilePath(wdGraphicsFiltersPath)
  Debug.Print "文書コンバータのパス：" & Application.Options.DefaultFilePath(wdTextConvertersPath)
  Debug.Print "校正ツールのパス：" & Application.Options.DefaultFilePath(wdProofingToolsPath)
  Debug.Print "一時ファイルのパス：" & Application.Options.DefaultFilePath(wdTempFilePath)
  Debug.Print "現在のフォルダ パス：" & Application.Options.DefaultFilePath(wdCurrentFolderPath)
  Debug.Print "テンプレートのパス：" & Application.Options.DefaultFilePath(wdStyleGalleryPath)
  Debug.Print "ページ罫線の絵柄のパス：" & Application.Options.DefaultFilePath(wdBorderArtPath)
End Sub

 

選択した文字列をシンボルフォントにする

選択した文字列をシンボルフォントに変更します。

Public Sub Sample()
  Application.WordBasic.SymbolFont
End Sub

 

保護されたビューウィンドウがどのように閉じられたかを取得する(Word 2010以降)

WdProtectedViewCloseReason列挙型から保護されたビューウィンドウがどのように閉じられたかを知ることができ、異常終了した場合も検知できます。

'ThisDocument
Option Explicit

Private WithEvents App As Word.Application

Public Sub Sample()
  Set App = Application
  Application.ProtectedViewWindows.Open "C:\Test\Test.doc"
End Sub

Private Sub App_ProtectedViewWindowBeforeClose(ByVal PvWindow As ProtectedViewWindow, ByVal CloseReason As Long, Cancel As Boolean)
  Select Case CloseReason
    Case wdProtectedViewCloseNormal
      MsgBox "ウィンドウは正常に閉じられました。", vbInformation
    Case wdProtectedViewCloseEdit
      MsgBox "保護されたビューの実行中にユーザーが [編集を有効にする] または [編集] をクリックしたときに、ウィンドウが閉じました。", vbInformation
    Case wdProtectedViewCloseForced
      MsgBox "アプリケーションが強制的にウィンドウをシャットダウンしたため、または応答しないために、ウィンドウが閉じました。", vbInformation
  End Select
End Sub

 

テキストフレームからテキストを削除する(Word 2010以降)

テキストフレームからテキストを削除し、さらにフォント属性などテキストに関連するすべてのプロパティを削除します。

Public Sub Sample()
  If ActiveDocument.Shapes(1).TextFrame.HasText Then
    ActiveDocument.Shapes(1).TextFrame.DeleteText
  End If
End Sub

 

印刷されない文字とWordの特殊文字を削除する

指定した文字列から、印刷されない文字と特殊文字を削除するかスペースに変換します。
「CleanString メソッド」参照。

Public Sub Sample()
  Dim s As String
  
  s = "ABC" & ChrW(160) & "DEF" & ChrW(176) & "GHI"
  MsgBox "特殊文字変換前：" & s & vbCrLf & _
         "特殊文字変換後：" & Application.CleanString(s)
End Sub

 

クリップボードビューアやコントロールパネルを表示する

クリップボードビューアやコントロールパネルを表示します。

Public Sub Sample()
  'クリップブック(クリップボードビューア)表示(※ Vista以降エラー)
  Application.WordBasic.ControlRun 0
  'コントロールパネル表示
  Application.WordBasic.ControlRun 1
End Sub

 

フォルダ数を取得する

フォルダの有無やフォルダ数を取得します。

Public Sub Sample()
  'フォルダ数取得
  MsgBox Application.WordBasic.CountDirectories("C:\Test\")
  'フォルダのパスが有効でない場合は「-1」を返す
  If Application.WordBasic.CountDirectories("C:\ZZZ\") = -1 Then MsgBox "フォルダが見つかりませんでした。"
End Sub

 

システム情報を表示する

システム情報を表示します。

Public Sub Sample()
'システム情報表示
  'Application.WordBasic.MicrosoftSystemInfo
  Word.System.MSInfo
End Sub

 

AccessやExcelを起動する

AccessやExcelを起動します。

Public Sub Sample()
  Application.WordBasic.MicrosoftAccess 'Access起動
  Application.WordBasic.MicrosoftExcel 'Excel起動
  Application.WordBasic.MicrosoftPowerPoint 'PowerPoint起動
End Sub

 

文字列をハイライト表示する(Word 2007以降)

Word 2007で追加されたHitHighlightメソッドを使って、文字列をハイライト表示します。
引数で検索条件やハイライト色を指定することが可能です。「Find.HitHighlight Method」参照。
※ テンプレート化したものがコチラ。

Public Sub Sample()
  With ActiveDocument.Content.Find
    .ClearHitHighlight 'ハイライトクリア
    .HitHighlight "テキスト", &H660000, wdColorWhite 'ハイライト表示
  End With
End Sub

 

選択した文字列を日本語入力システムの辞書に単語登録する

文書中で選択した文字列を、使用中の日本語入力システムの辞書に単語登録します。
※ 環境によっては実行できません(Word 2010 + ATOK 2009では確認できました)。

Public Sub Sample()
  Application.WordBasic.EditUpdateIMEDic
End Sub

 

文書が1ページ少なくなるように文字の大きさを小さくする

作業中の文書が1ページ少なくなるように文字の大きさを小さくします。
1ページ減らすことができない場合は、エラーが発生します。

Public Sub Sample()
  'Application.WordBasic.ToolsShrinkToFit
  Application.ActiveDocument.FitToPages
End Sub

 

全画面表示のオン/オフを切り替える

全画面表示のオン/オフを切り替えます。

Public Sub Sample()
  Application.WordBasic.ToggleFull
End Sub

 

Ctrlキー + Breakキーによるマクロの割り込みができないようにする

Ctrlキー + Breakキーによるマクロの割り込みができないようにします。

Public Sub Sample()
  Dim i As Long
  
  Application.EnableCancelKey = wdCancelDisabled
  For i = 1 To 20000
    Debug.Print i
    DoEvents
  Next
  Application.EnableCancelKey = wdCancelInterrupt
End Sub

 

自動実行マクロが実行されないようにする

AutoOpen等の自動実行マクロが実行されないようにします。
再度実行できるようにしたい場合は「WordBasic.DisableAutoMacros 0」を実行するか、Wordを再起動する必要があります。

Public Sub Sample()
  Application.WordBasic.DisableAutoMacros 1
End Sub

 

空白行を削除する

空白行を削除するマクロです。

Public Sub Sample()
  Dim tmp As Long
  
  tmp = 0
  With ActiveDocument.Range.Find
    .ClearFormatting
    .Text = "^p^p"
    .Replacement.Text = "^p"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchFuzzy = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    Do While .Execute(Replace:=wdReplaceAll)
      If tmp = ActiveDocument.Range.End Then Exit Do
      tmp = ActiveDocument.Range.End
    Loop
  End With
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

 

文字や段落の書式を削除する(Word 2007以降)

文字や段落の書式を削除するマクロです。

Public Sub Sample()
  '選択した文字列から文字書式(リボンのボタンやダイアログボックスを使用して手動で適用した書式)を削除します。
  Selection.ClearCharacterDirectFormatting
  '選択した文字列から、文字スタイルを使用して適用した文字書式を削除します。
  Selection.ClearCharacterStyle
  '選択した文字列からすべての文字書式(文字スタイルを使用して適用した書式または手動で適用した書式)を削除します。
  Selection.ClearCharacterAllFormatting
End Sub

Public Sub Sample2()
  '選択した文字列から、リボンのボタンやダイアログボックスを使用して手動で適用した段落書式を削除します。
  Selection.ClearParagraphDirectFormatting
  '選択した文字列から、段落スタイルを使用して適用した段落書式を削除します。
  Selection.ClearParagraphStyle
  '選択した文字列からすべての段落書式(段落スタイルを使用して適用した書式または手動で適用した書式)を削除します。
  Selection.ClearParagraphAllFormatting
End Sub

 

指定した範囲を別文書としてエクスポートする(Word 2007以降)

指定した範囲を別文書としてエクスポート、また、指定位置に文書をインポートするマクロです。
※ 下記コードを応用したものがコチラ。

Public Sub Sample()
  Const FilePath As String = "D:\Fragment.docx"
  
  '選択した範囲を「FilePath」にエクスポート
  Selection.Range.ExportFragment FilePath, wdFormatDocumentDefault
  Selection.EndKey wdStory
  '選択位置に文書フラグメントをインポート
  Selection.Range.ImportFragment FilePath, True
End Sub

 

文字色をダイアログから選択する

Windowsのカラーダイアログから、選択した文字列の色を選択するマクロです(2003 ～ 2010で動作確認)。

Option Explicit

Private Type ChooseColor
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  rgbResult As Long
  lpCustColors As Long
  flags As Long
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Declare Function ChooseColor Lib "comdlg32" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long
Private Const CC_ANYCOLOR = &H100

Public Sub Sample()
  Dim col As Long
  
  If GetColor(col) Then
    ActiveDocument.Range(0, 9).Font.Color = col
  End If
End Sub

Private Function GetColor(ByRef col As Long) As Boolean
'色取得
  Dim cc As ChooseColor
  Dim custcol(15) As Long
  Dim ret As Boolean
  Dim i As Long
  
  'カスタムカラー:白
  For i = 0 To 15
    custcol(i) = RGB(255, 255, 255)
  Next
  
  With cc
    .lStructSize = Len(cc)
    .hwndOwner = 0&
    .flags = CC_ANYCOLOR
    .lpCustColors = VarPtr(custcol(0))
    If ChooseColor(cc) = 0& Then
    'キャンセル時
      col = RGB(255, 255, 255)
      ret = False
    Else
      col = cc.rgbResult
      ret = True
    End If
  End With
  GetColor = ret
End Function

 

文字色をダイアログから選択する(Word 2003まで)

選択した文字列の色をカラーダイアログから選択するマクロです(2003まで)。

Public Sub Sample()
  ActiveDocument.Range(0, 9).Select '文字選択
  Application.CommandBars("Font Color").Visible = True '文字色選択ダイアログ表示
End Sub

 

文字色をダイアログから選択する(Word 2007以降)

選択した文字列の色をカラーダイアログから選択するマクロです(2007以降)。

Public Sub Sample()
  ActiveDocument.Range(0, 9).Select '文字選択
  Application.CommandBars.ExecuteMso "FontColorMoreColorsDialog" '文字色選択ダイアログ表示
End Sub

 

環境変数の値を取得する

Environ/Environ$関数でシステム環境変数の値を取得することができます。
引数の文字列はコマンドプロンプトから「set」コマンドを実行することで確認できます。

Public Sub Sample()
  Debug.Print VBA.Environ$("LOCALAPPDATA")
  Debug.Print VBA.Environ$("ComSpec")
  Debug.Print VBA.Environ$("SystemRoot")
  Debug.Print VBA.Environ$("windir")
End Sub

 

プリンタを指定して印刷する

プリンタを指定して印刷するマクロです。

Public Sub Sample()
  Dim tmp As String
  
  tmp = Application.ActivePrinter
  Application.ActivePrinter = "(印刷するプリンタ名)"
  ActiveDocument.PrintOut
  Application.ActivePrinter = tmp
End Sub

 

インストールされているプリンタを列挙する

インストールされているプリンタを列挙するマクロです。

Public Sub Sample()
  Dim colItems As Object
  Dim itm As Object
  
  Set colItems = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * from Win32_Printer")
  For Each itm In colItems
    Debug.Print itm.Name
  Next
  Set colItems = Nothing
End Sub

Public Sub Sample2()
  Dim itm As Object
  
  With CreateObject("Shell.Application")
    For Each itm In .Namespace(4).Items
      Debug.Print itm.Name
    Next
  End With
End Sub

 

NumLock/CapsLockのオン・オフを取得する

NumLock/CapsLockのオン・オフを取得するマクロです。

Public Sub Sample()
  Debug.Print "NumLock:" & Application.NumLock
  Debug.Print "CapsLock:" & Application.CapsLock
  Debug.Print "NumLock:", Selection.Information(wdNumLock)
  Debug.Print "CapsLock:", Selection.Information(wdCapsLock)
End Sub

 

トップページ > Office関連 > Wordマクロ備忘録(Word VBA)