【Word VBA/マクロ】本文、ヘッダーフッター、オートシェイプ置換

Oct 23, 2023

【Word VBA/マクロ】本文、ヘッダーフッター、オートシェイプ置換

カテゴリ：Word VBA

追記：2023年12月4日
マクロの記事は下記のサイトで書くことにしました。
Word VBA/マクロ備忘録

Sub 本文、ヘッダーフッター、オートシェイプ置換()

Dim mae As String

Dim ato As String

Dim sec As Section

Dim hdr As HeaderFooter

Dim ftr As HeaderFooter

Dim rng As Range

Dim shp As Shape, gShp As Shape, inlShp As InlineShape, satNode As SmartArtNode

mae = "■" '検索するキーワード

ato = "□" '検索後のキーワード

'本文置換

' On Error Resume Next

Set rng = ActiveDocument.Range(0, 0)

With rng.Find

.Text = mae

.Replacement.Text = ato

.Execute Replace:=wdReplaceAll

End With

'ヘッダーフッター内置換

For Each sec In ActiveDocument.Sections

For Each hdr In sec.Headers

With hdr.Range.Find

.Text = mae

.Replacement.Text = ato

.Execute Replace:=wdReplaceAll

End With

For Each ftr In sec.Footers

With ftr.Range.Find

.Text = mae

.Replacement.Text = ato

.Execute Replace:=wdReplaceAll

End With

'オートシェイプ内置換

For Each shp In ActiveDocument.Shapes

If shp.Type = msoGroup Then

For Each gShp In shp.GroupItems

If gShp.TextFrame.HasText Then

With gShp.TextFrame.TextRange.Find

.Text = mae

.Replacement.Text = ato

.Execute Replace:=wdReplaceAll

End With

End If

If shp.TextFrame.HasText Then

Set rng = shp.TextFrame.TextRange

With rng.Find

.Text = mae

.Replacement.Text = ato

.Execute Replace:=wdReplaceAll

End With

End If

End Sub

お気に入りの記事を「いいね！」で応援しよう

Last updated Dec 4, 2023 10:23:16 AM
コメント(0) | コメントを書く

[Word VBA] カテゴリの最新記事

在宅仕事日記

【Word VBA/マクロ】本文、ヘッダーフッター、オートシェイプ置換