【ユーザーライブラリ】Powerpoint文字列一括置換方法
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