【Word VBA/マクロ】使用スタイルのリスト表示

サンプルコードでできること

使用しているスタイルの一覧を取得して、メッセージボックスに表示します。

Sub getStyleList_Activedocument()
    Dim strList As String
    strList = getStyleList(ActiveDocument)
    MsgBox strList
End Sub

Private Function getStyleList(dc As Document) As String
'使用した段落スタイルの一覧を取得します。
    Dim para As Paragraph, styleList As String
    Dim stl As Variant
    Dim dic As Scripting.Dictionary
    Set dic = New Scripting.Dictionary

    For Each para In dc.Paragraphs
        If dic.Exists(para.Style.NameLocal) = False Then
            dic.Add para.Style.NameLocal, ""
        End If
    Next
    
    For Each stl In dic.Keys
        styleList = styleList & stl & vbCrLf
    Next
    getStyleList = styleList
End Function

コードの説明

Wordではスタイルウインドウに「使用中のスタイル」を表示できます。
そのリストを取得するコードでいいと思ったのですが、「見出し 1」など使用されていないスタイルも含まれるようです。

段落ごとにスタイル名を取得していく無難な方法にしました。
For Eachを用いたリスト化は簡単ですが、スタイル名が重複します。
そのためDictionaryオブジェクトでスタイル名が登録されていないかチェック（dic.Exists(para.Style.NameLocal）しています。

【Word VBA/マクロ】段落書式コピー

サンプルコードでできること

選択した段落の書式を、前の段落に合わせます。

Ctrl+Shift+Cキーで段落書式コピーできますが、前の段落に移動してコピー、戻って貼り付けが意外と面倒です。
マクロをボタン化すると、ショートカットより楽です。

Sub CopyPrePaaraFormat()
    Dim preParFmt As ParagraphFormat
    Set preParFmt = _
        Selection.Paragraphs(1).Previous.Range.ParagraphFormat
    Selection.ParagraphFormat = preParFmt
End Sub

【Word VBA/マクロ】選択図形のアンカーロック/ロック解除（複数の図に対応）

サンプルコードでできること

選択した図のアンカーをロック（ロック解除）します。

Sub LockAnchorAllShpe()
’アンカーをロックします。
    Dim sp As Shape
    
    For Each sp In Selection.ShapeRange
        Selection.ShapeRange.LockAnchor = True
    Next
End Sub

Sub LockAnchorCancellAllShpe()
’アンカーをロック解除します。
    Dim sp As Shape
    
    For Each sp In Selection.ShapeRange
        Selection.ShapeRange.LockAnchor = False
    Next
End Sub

【Word VBA/マクロ】フォルダ内の全てのWordファイルにドキュメントプロパティの作成者名を設定

サンプルコードでできること

フォルダ内のWordファイルのドキュメントプロパティの作成者名をセットします。

Sub setDocumentProperty_Author_Folder()
    Dim Path As String, strName As String
    Dim fs As Scripting.FileSystemObject
    Dim baseFolder As Scripting.Folder
    Dim mySubFile As Scripting.File, mySubFiles As Scripting.FILES
    Dim dc As Document, hidFile As Boolean
    Dim dlg As FileDialog
    
    strName = "○○" '作成者名を代入
    
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub
    ' フォルダーのフルパスを変数に格納
    Path = dlg.SelectedItems(1)
    
    Set fs = New Scripting.FileSystemObject
    Set baseFolder = fs.GetFolder(Path)
    Set mySubFiles = baseFolder.FILES
    
    For Each mySubFile In mySubFiles
        hidFile = False
        '隠しファイルの判定
        If mySubFile.Attributes = 2 Or _
            mySubFile.Attributes = 34 Then
            hidFile = True
        End If
        
        If hidFile = False Then
            If fs.GetExtensionName(mySubFile.Path) = "doc" Or _
                fs.GetExtensionName(mySubFile.Path) = "docx" Then
                Documents.Open mySubFile.Path
                Set dc = ActiveDocument
                With dc
                    .BuiltInDocumentProperties("Author") = strName
                    .Close SaveChanges:=True
                End With
            End If
        End If
    Next
End Sub

【Word VBA/マクロ】指定フォルダ内のファイルからドキュメントプロパティのデータを抽出

サンプルコードでできること

フォルダ内のWordファイルから、ドキュメントプロパティのタイトル・サブタイトル・作成者を新規文書に書き出します。

Sub getDocumentPropertyList_AuthorTitleSubject_Folder()
    Dim Path As String, pgInfo As String
    Dim fs As Scripting.FileSystemObject
    Dim baseFolder As Scripting.Folder
    Dim mySubFile As Scripting.File, mySubFiles As Scripting.FILES
    Dim dc As Document, dcNew As Document
    Dim hidFile As Boolean, para As Paragraph
    Dim dlg As FileDialog, b As Boolean, bLevelList As String
    
    b = False
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' キャンセルボタンクリック時にマクロを終了
    If dlg.Show = False Then Exit Sub
    ' フォルダーのフルパスを変数に格納
    Path = dlg.SelectedItems(1)
    
    Set fs = New Scripting.FileSystemObject
    Set baseFolder = fs.GetFolder(Path)
    Set mySubFiles = baseFolder.FILES
    
    For Each mySubFile In mySubFiles
        hidFile = False
        '隠しファイルの判定
        If mySubFile.Attributes = 2 Or _
            mySubFile.Attributes = 34 Then
            hidFile = True
        End If
        
        If hidFile = False Then 
            If fs.GetExtensionName(mySubFile.Path) = "doc" Or _
                fs.GetExtensionName(mySubFile.Path) = "docx" Then
                Documents.Open mySubFile.Path, ReadOnly:=True
                Set dc = ActiveDocument
                If b = False Then
                    Set dcNew = Documents.Add 
                    b = True
                End If
                'ドキュメントプロパティの内容挿入
                getDocumentProperty_AuthorTitleSubject dc, dcNew
                dc.Close SaveChanges:=False
            End If
        End If
    Next
    
dcNew.Range(0, 0).Select
End Sub

Private Sub getDocProperty_AuthorTitle(docFrom As Document, docTo As Document)
    Dim docProp As DocumentProperty
    Dim dcPpText As String
    On Error Resume Next
    docTo.Range.Bookmarks("\EndOfDoc").Select
        With Selection
            .InsertAfter docFrom.Name & vbCrLf 'ファイル名挿入
            .Range.Font.Bold = True
            .EndKey wdStory
            .InsertAfter "Title: " & _
                docFrom.BuiltInDocumentProperties("Title").Value & vbCrLf
            .InsertAfter "Subject: " & _
                docFrom.BuiltInDocumentProperties("Subject").Value & vbCrLf
            .InsertAfter "Author: " & _
                docFrom.BuiltInDocumentProperties("Author").Value & vbCrLf
            .InsertAfter vbCr
        End With
End Sub

【Word VBA/マクロ】ドキュメントプロパティの全項目を取得

サンプルコードでできること

ドキュメントプロパティの全ての項目を新規文書に書き出します。

Sub ドキュメントプロパティ取得()
    Dim docTo As Document, docProp As DocumentProperty

    Set docTo = Documents.Add '書き出し用のファイル

    On Error Resume Next
        For Each docProp In ActiveDocument.BuiltInDocumentProperties
            Selection.InsertAfter docProp.Name & ": " & _
            docProp.Value & vbCrLf
        Next
    Selection.StartOf wdStory, wdMove ’文書先頭へ移動
End Sub

コードの説明

ActiveDocument.BuiltInDocumentPropertiesで、DocumentPropertiesオブジェクトを取得。
For Eachでタイトル、作成者など、DocumentPropertyオブジェクトの値を取得して、新規文書に書き出します。

【Word VBA/マクロ】コメントユーザー名の変更

サンプルコードでできること

コメントの特定の作成者の名前を変更します。

Sub コメントユーザー名変更()
'コメントのユーザー名を変更します。
    Dim cmt As Comment, strInitial As String
    Dim MaeName As String, AtoName As String
    
    MaeName = "たなか" '変更前の名前
    AtoName = "Tanaka" '変更後の名前
    strInitial = "T" '変更後のイニシャル
    
    For Each cmt In ActiveDocument.Range.Comments
        With cmt
            .Author = AtoName
            .Initial = strInitial
        End With
    Next
End Sub

コードの説明

For Eachを用いて、特定の作成者を1つずつ変更します。
Authorプロパティは、オブジェクトブラウザの非表示メンバーのため、薄い文字で表示されます。
（「非表示のメンバーを表示」をオンで表示できます。）