【Word VBA/マクロ】隠し文字解除

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

隠し文字を解除します。

解除対象
・本文
・オートシェイプ
・脚注
・ヘッダー・フッター
・ヘッダー・フッター内のオートシェイプ
・描画キャンパス

コードの説明

コードが長くなるため、解除対象ごとにプロシージャを分けています。
隠し文字の解除は、通常は下記の4つでOK。
・本文
・オートシェイプ
・脚注
・ヘッダー・フッター

下記の2つは、珍しく支給されたデータに含まれていたため、コードを追加しました。
・ヘッダー・フッター内のオートシェイプ
・描画キャンパス

スマートアートは解除対象から外しています。

Sub 隠し文字_全解除()
    隠し文字解除_本文
    隠し文字解除_オートシェイプ
    隠し文字解除_脚注
    隠し文字解除_ヘッダーフッター
    隠し文字解除_ヘッダーフッター_TextBox
    隠し文字解除_描画キャンパス
End Sub

Private Sub 隠し文字解除_本文()
  With ActiveDocument.Range
    .Font.Hidden = False
  End With
End Sub

Private Sub 隠し文字解除_オートシェイプ()
    Dim shp As Shape, gItem As Object
    Dim i As Long
    
    For Each shp In ActiveDocument.Shapes
        With shp.TextFrame
            If .HasText Then
               .TextRange.Font.Hidden = False
            End If
        End With
        
        If shp.Type = msoGroup Then
            For i = 1 To shp.GroupItems.Count
                With shp.GroupItems(i)
                    If .Type = msoAutoShape Or msoTextBox Then
                        If .TextFrame.HasText Then
                            .TextFrame.TextRange.Font.Hidden = False
                        End If
                    End If
                End With
            Next
        End If
    Next
End Sub

Private Sub 隠し文字解除_脚注()
    If ActiveDocument.Footnotes.Count >= 1 Then
            With ActiveDocument.ActiveWindow.View
                .Type = wdPrintView
                 .SeekView = wdSeekFootnotes
            End With
            Selection.WholeStory
            With Selection.Font
                .Hidden = False
            End With
        ActiveDocument.Range(0, 0).Select
    End If
    
'文末脚注
    If ActiveDocument.Endnotes.Count >= 1 Then
            With ActiveDocument.ActiveWindow.View
                .Type = wdPrintView
                 .SeekView = wdSeekEndnotes
            End With
            Selection.WholeStory
            With Selection.Font
                .Hidden = False
            End With
        ActiveDocument.Range(0, 0).Select
    End If
End Sub

Private Sub 隠し文字解除_ヘッダーフッター()
Dim sec As Section
Dim hdr As HeaderFooter
Dim ftr As HeaderFooter

    With ActiveDocument.Range
      .Font.Hidden = False
    End With

    For Each sec In ActiveDocument.Sections
        For Each hdr In sec.Headers
            hdr.Range.Font.Hidden = False
        Next        
        For Each ftr In sec.Footers
            ftr.Range.Font.Hidden = False
        Next
    Next
End Sub

Private Sub 隠し文字解除_ヘッダーフッター_TextBox()
    Dim hdr As HeaderFooter, ftr As HeaderFooter
    Dim sec As Section, shp As Shape
    
    For Each sec In ActiveDocument.Sections
            For Each hdr In sec.Headers
                hdr.Range.Font.Hidden = False
                For Each shp In hdr.Shapes
                    With shp.TextFrame
                        If .HasText Then
                            .TextRange.Font.Hidden = False
                        End If
                    End With
                Next
            Next
            
            For Each ftr In sec.Footers
                ftr.Range.Font.Hidden = False
                For Each shp In ftr.Shapes
                    With shp.TextFrame
                        If .HasText Then
                            .TextRange.Font.Hidden = False
                        End If
                    End With
                Next
            Next
    Next
End Sub

Private Sub 隠し文字解除_描画キャンパス()
    Dim shp As Shape, cItem As Shape
    Dim cSha As Shape
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoCanvas Then
            If shp.Type = msoGroup Then
                For Each cItem In shp.GroupItems
                    With cItem.TextFrame
                        If .HasText Then
                            .TextRange.Font.Hidden = False
                        End If
                    End With
                Next
            Else
                For Each cSha In shp.CanvasItems
                    With cSha.TextFrame
                        If cSha.TextFrame.HasText = True Then
                            cSha.TextFrame.TextRange.Font.Hidden = False
                        End If
                    End With
                Next
            End If
        End If
    Next
End Sub