![[CX's MEMO]](image/cx_memo.jpg "[CX's MEMO]")
' ＜使い方＞
' 1. Power Point の「Visual Basic Editor」を起動します。
' 2. [挿入] - [標準モジュール] を選択します。
' 3. 下記のコードを貼り付けます
' 4. [実行] - [Sub/ユーザー フォームの実行] で
' ChangeKanaText() プロシージャを実行します。
' → スライド上の文字列を一括置換します。
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 ChangeKanaText()
' スライドを取得
Dim slide
For Each slide In ActiveWindow.Parent.Slides
' スライド内のシェイプオブジェクト（テキストボックス等）を取得
Dim shape
For Each shape In slide.Shapes
' シェイプ（テキストボックス等）の単語を取得
Dim word
For Each word In 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 Sub> 質問ですが、VBAの記述の中で修正しなければならない > （はてなの投稿で全角になってしまった部分） > は、[ア-ンア-ン]のところでしょうか？ > どこを半角に修正すればよいでしょうか？ はてな投稿時に全角になってしまう部分は「’」「”」「￥」の部分と半角カタカナです。 [ア-ンア-ン] は、実際は [全角ア-ン、半角ｱ-ﾝ] となっています。 あと、ソースコードを見やすくする為、全角スペースでインデントを 付けてあります。 コードを修正するのが面倒であれば、 http://www.hondarer-soft.com/cx/pukiwiki/pukiwiki.php?Memo%2F2004-12-27 にオリジナルのソースコードを置いてありますので、こちらをご利用ください。 > 実行してみましたが、 > For Each word In shape.TextFrame.TextRange.Words > のところでひっかかりました。 > 『TextFrame.TextRange：無効な要求です。この種類の図形にテキスト枠は設定できません。』 > というメッセージです。 該当ファイルが無いので、実際の事象が分かりませんが、 おそらく、テキストフレームを含まないようなシェイプオブジェクトが 存在する為だと思われます。 想定される問題に対応したバージョンを作成致しました。
' ＜使い方＞
' 1. Power Point の「Visual Basic Editor」を起動します。
' 2. [挿入] - [標準モジュール] を選択します。
' 3. 下記のコードを貼り付けます
' 4. [実行] - [Sub/ユーザー フォームの実行] で
' ChangeKanaText() プロシージャを実行します。
' → スライド上の文字列を一括置換します。
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 slide
For Each slide In ActiveWindow.Parent.Slides
' スライド内のシェイプオブジェクト（テキストボックス等）を取得
Dim shape
For Each shape In slide.Shapes
' シェイプが TextFrame を持つ場合のみ後続の処理を実行
If shape.HasTextFrame = msoTrue Then
' シェイプ（テキストボックス等）の単語を取得
Dim word
For Each word In 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
End If
Next
Next
End Sub
