6

Wordファイルの文字列置換を投稿したのでPowerpointについても投稿を行います。
私はPowerpointにて表も使用するので、表の中の文字列も置換するように
作成しています。
オプションは必要に応じて消して使用してください。
ドキュメントの文字の統一なんかに使えます。

参考まで。

<サンプルスクリプト>
word = !検索文字列!
repword = !置換文字列!

Dim sld
Dim shp

Dim txtRng
Dim foundText
Dim firstAddress
Dim clm
Dim cl

Set objPpt = Nothing
Set objPpx = Nothing

On Error Resume Next
Set objPpt = GetObject(, "PowerPoint.Application")

If objPpt is Nothing then
Set objPpt = CreateObject("PowerPoint.Application")
End if

If objPpt is Nothing then
Err.Raise 1, "", "指定されたPowerPointアプリケーションが開けません。"
End if

objPpt.Visible = True
Set objPpx = objPpt.ActivePresentation

For Each sld In objPpx.Slides
For Each shp In sld.Shapes
' オブジェクトの中のテキストを処理
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
Set foundText = txtRng.Find(word)

' 置換対象文字列が見つからなければ次へ
If foundText Is Nothing Then

Else
firstAddress = foundText.Address
Do
' 対象のテキストを太文字とする
foundText.Font.Bold = True
' 対象のテキストを赤色文字とする
foundText.Font.Color = RGB(255, 0, 0)

' 対象のテキストを置換
foundText = Replace(foundText, word, repword)
txtRng.Find(word).Text = foundText
Set foundText = txtRng.FindNext(word)
If foundText.Address = firstAddress Then
Exit Do
End If
Loop
End If
End If

If shp.HasTable Then
For Each clm In shp.Table.Columns
' 表の中のテキストを処理
For Each cl In clm.cells
Set txtRng = cl.Shape.TextFrame.TextRange
Set foundText = txtRng.Find(word)

' 置換対象文字列が見つからなければ次へ
If foundText Is Nothing Then

Else
firstAddress = foundText.Address
Do
' 対象のテキストを太文字とする
foundText.Font.Bold = True
' 対象のテキストを赤色文字とする
foundText.Font.Color = RGB(255, 0, 0)

' 対象のテキストを置換
foundText = Replace(foundText, word, repword)
txtRng.Find(word).Text = foundText
Set foundText = txtRng.FindNext(word)
If foundText.Address = firstAddress Then
Exit Do
End If
Loop
End If
Next
Next
End If
Next
Next
On Error Goto 0

Set txtRng = Nothing
Set foundText = Nothing
Set objPpx = Nothing
Set objPpt = Nothing

質問の投稿