PowerPointマクロで全角半角置換

Option Explicit

Function IsKatakana(strTarget As String) As Boolean
Dim strPattern
strPattern = "[ア-ンｱ-ﾝ]" ' カタカナ範囲チェック用
Dim reg As Object
Set reg = CreateObject("VBScript.RegExp") ' 正規表現コンポーネントを利用
reg.Pattern = strPattern
IsKatakana = reg.Test(strTarget)
Set reg = Nothing
End Function

Sub ChangeKanaText2()
' スライドを取得
Dim sld As slide
For Each sld In ActiveWindow.Parent.Slides
' スライド内のシェイプオブジェクト（テキストボックス等）を取得
Dim shp
For Each shp In sld.Shapes
' シェイプが TextFrame を持つ場合のみ後続の処理を実行
If shp.HasTextFrame Then
' シェイプ（テキストボックス等）の単語を取得
Dim word
For Each word In shp.TextFrame.TextRange.Words
' 文字列の置換
If IsKatakana(word.Text) = True Then
' カタカナの場合は全角に変換
word.Text = StrConv(word.Text, vbWide)
Else
' それ以外は半角に変換
word.Text = StrConv(word.Text, vbNarrow)
End If
Next
End If
' シェイプが 表 を持つ場合（追加）
Dim myRow As Row
Dim myCell As Cell
If shp.HasTable Then
For Each myRow In shp.Table.Rows
For Each myCell In myRow.Cells
For Each word In myCell.Shape.TextFrame.TextRange.Words
If IsKatakana(word.Text) = True Then
word.Text = StrConv(word.Text, vbWide)
Else
word.Text = StrConv(word.Text, vbNarrow)
End If
Next
Next
Next
End If
Next
Next
End Sub