' <使い方> ' 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