PowerPoint 2010での特定の色・サイズ

質問

PowerPoint 2010で作成した授業用スライドがあり、
各スライド中で、重要語句の部分のみ赤色でフォントサイズが大きく（48pt）
なっています。そのほかの部分は黒色でもっと小さなフォントです。

行いたいことは、この、スライド中の「赤色で48ptの文字」を、
すべて一括して「＿」に置換することです。
たとえば、スライド中に赤色・48ptで「運動方程式」と書かれていたら、
それを「＿＿＿＿＿」に置換したいと考えています。
そうすると、そのまま資料として印刷して、重要語句の部分だけは受講生が書き込む
形式で授業を進めることができますので。そこで質問なのですが、
この操作をPowerPoint 2010で行うにはどのようにしたらよいでしょうか。

VBAを使うことになりそうだと考えており、
http://q.hatena.ne.jp/1104101386
などが参考になりそうなのですが、「赤色で48ptの文字」を「＿」に
置換する部分をどのように書けばよいかがわかりません。

当方、BASICやperlなどのプログラミングの経験はかつて多少ありますが、
VBAはろくに使ったことがありません。
おわかりの方がいらっしゃいましたら教えていただきたく、
どうぞよろしくお願いいたします。

回答No.1

DOUGLAS_ · ベストアンサー

お示しの URL の #1 さんのご回答を参考にして書いてみました。

　[日本語用のフォント] が施された文字は全角の「＿」、それ以外は半角の「_」に書き換えるようにしておりますが、全角の「＿」と半角の「_」とでは、文字の ベースライン が揃わないようですので、お気に召さなければ、後からすべて削除（半角の「_」を無文字にすべて置換）してください。

　EXCEL VBA とは違って余り細々と操作できなさそうですので、このへんでご勘弁を。。。
<(_ _)>

　なお、「赤色」とお書きなのが本当の「赤」でしたら、
RGB(Red:=255, Green:=0, Blue:=102)
の部分は
RGB(Red:=255, Green:=0, Blue:=0)
になるかと存じます。
　[新しいマクロの記録] で、実際に「赤色」を施してみて、RGB の値を取得してください。

＞当方、BASICやperlなどのプログラミングの経験はかつて多少あります
とのことですので、コーディング の操作内容はご理解いただけると存じますが、
＞VBAはろくに使ったことがありません。
とのことですので、EXCEL VBA についての説明ですが、
http://okwave.jp/qa/q6129006.html
の #31【お別れの言葉】でもご覧ください。

'-------------------------------------------------------
Sub ChangeUnderBar()
　Dim objSlide As slide
　Dim objShape As shape
　Dim objWord As TextRange
　Dim objChara As TextRange
　For Each objSlide In ActiveWindow.Parent.Slides
　　For Each objShape In objSlide.Shapes
　　　For Each objWord In objShape.TextFrame.TextRange.Words
　　　　For Each objChara In objWord.Characters
　　　　　'「赤色・48pt」の場合は「＿」に変換
　　　　　If objChara.Font.Size = 48 And _
　　　　　　objChara.Font.Color.RGB = RGB(Red:=255, Green:=0, Blue:=102) Then
　　　　　　Select Case objChara.LanguageID
　　　　　　　Case msoLanguageIDJapanese
　　　　　　　　objChara.Text = "＿"
　　　　　　　Case Else
　　　　　　　　objChara.Text = "_"
　　　　　　End Select
　　　　　　objChara.Font.Size = 48
　　　　　　objChara.Font.Color.RGB = RGB(0, 0, 0)
　　　　　End If
　　　　Next
　　　Next
　　Next
　Next
End Sub

お礼

コード付きのすばらしいご回答をいただき、心より御礼申し上げます。
全角の場合と半角の場合の違いまで、当初申し上げてもおりませんでしたのに
考慮していただいて、心より感謝いたします。
いただいたコードを拝見し、なるほどVBAではこのような
書き方になるのかと、VBA素人なりに合点がいきました。

ただ、実は私の環境では、いただいたものをそのまま実行すると

実行時エラー '-2147024809 (80070057)':
指定された値は境界を超えています。

というエラーメッセージが表示され、デバッグボタンを押すと

For Each objWord In objShape.TextFrame.TextRange.Words

の行が黄色くマーキングされます。
とくに、objWordの上にマウスカーソルを当てると
「objWord = Nothing」というポップアップが表示されます。

私の環境については、ループ範囲の設定が適切ではないという
趣旨のエラーなのかなと想像しております。
他の質問なども参考にIn以下を少し変えたりなど試してみておりますが
まだうまく実行できてはおりません、が、かなりゴールに近づいて
いるとは思いますのでもう少しねばってみたいと思います。
もしもなにか思い当たる節がおありでしたら、重ね重ねで恐縮ですが
教えていただだければ大変ありがたいです。
この度は本当にありがとうございました。

補足

お礼を投稿したあとで申し訳ないのですが、その後のご報告です。
いろいろと試してみまして、
http://www.d-consulting.biz/presentation/powerpoint/vba_change_font/
にヒントを得て、2度目のループと3度目のループの間に
If objShape.HasTextFrame Then
の一文を入れ、全体を以下のようにすることにより、
プログラムを動作させることができました。

この方法では、表の中の文字、助詞、一部テキストボックス中の文字など、
いくつか「赤字・48pt」でも変換できないところが依然残ってしまってはおりますが
それでも主観ですが全体の8～9割の置き換えには成功しており、
逐一手作業で置き換えるよりはこれで大幅に負担が軽減できます。
本当にどうもありがとうございました。
「完全に」動作させるためのアドバイスなど、もしもお気づきでしたら、
重ね重ねで恐縮ですが、再度ご助言いただけましたら大変幸いに存じます。

'-------------------------------------------------------
Sub ChangeUnderBar()
Dim objSlide As Slide
Dim objShape As Shape
Dim objWord As TextRange
Dim objChara As TextRange
For Each objSlide In ActiveWindow.Parent.Slides
For Each objShape In objSlide.Shapes
If objShape.HasTextFrame Then 'ここが追加
For Each objWord In objShape.TextFrame.TextRange.Words
For Each objChara In objWord.Characters
'「赤色・48pt」の場合は「＿」に変換
If objChara.Font.Size = 48 And _
objChara.Font.Color.RGB = RGB(Red:=255, Green:=0, Blue:=0) Then
Select Case objChara.LanguageID
Case msoLanguageIDJapanese
objChara.Text = "＿"
Case Else
objChara.Text = "_"
End Select
objChara.Font.Size = 48
objChara.Font.Color.RGB = RGB(0, 0, 0)
End If
Next
Next
End If 'ここが追加
Next
Next
End Sub

回答No.2

DOUGLAS_

＞ヒントを得て・・・の一文を入れ
　さすがっ！　(^o^)
　私の思った通りの方でした。ＷＥＢ検索力 と プログラミング の基礎理解がありですね。

＞表の中の文字、助詞、一部テキストボックス中の文字など、
＞いくつか「赤字・48pt」でも変換できないところが依然残ってしまってはおります
＞全体の8～9割の置き換えには成功
　原因はよく分かりませんが、確認事項としては、「依然残ってしまって」いる文字の フォント 設定を確認してみて、「赤字・48pt」になっているかどうかでしょうか？
　「赤字」のように見えて果たして
RGB(Red:=255, Green:=0, Blue:=0)
かどうかですね。

　また、文字数が変化して シェイプ 内の行数が増減すると、設定している フォント サイズ が自動的に変化するようですので、その辺りが関係しているのかも知れません。
　この場合でしたら、
If objChara.Font.Size > 40 And _
のような指定にすればよいかと存じます。

　また、その他に、私自身の確認では、半角文字の前後で「依然残ってしま」う現象が発生します。

　あるいは、次のようにして原因を特定できるかも知れません（今後のためのご参考になるかも。。。です）。
１）[新しいプレゼンテーション] を開き、「依然残ってしまって」いる シェイプ を コピペ します。
２）ＰＰ と ＶＢＥ とを並べて表示し、ＶＢＥ において、 [F8] キー を押下しながら ステップインデバッグ していきます。
３）「依然残ってしまって」いる文字の前まできたら、慎重に [F8] キー を押下していき、その都度、ローカル ウィンドウ の「objChara」の 各プロパティ の値の変化を確認しながら、また [F8] キー を押下する、という具合に確認していきます。
　プロパティ の当たりがついたら、「objChara.{当該プロパティ}」を [ウォッチ式の追加] し、ウォッチ ウィンドウ で値の変化を確認してもよいかと存じます。

お礼

DOUGLAS_様、重ね重ね、どうもありがとうございました。
今回教えていただいた[F8]を押してワンステップずつ確認していく方法は
目からうろこでした…なるほど、このようなチェックの仕方がありうるのですね。

また、フォントサイズが不等式で指定できることもとても参考に
なりました。たしかに、行数を多くしたりすると自動的にフォントが
小さくなったりしますので、こちらを使わせていただく方がよさそうです。

ちなみに色については、前回申しあげればよかったのですが、私が使って
いるのはすべてRGB(Red:=255, Green:=0, Blue:=0)の赤のようでした。

インターネット越しに、このようにご親切にご教示賜りまして
心より感謝しております。勉強不足でまだ100%までは至っておりませんが、
すでにここまででも当初の目的は十分に達成できています。
今回教えていただいた内容やコードはまたとない実践的な教材ですので、
これをきっかけとさせていただいて、今後プロパティの種類など
VBの基礎も少しずつ勉強していき、時間をかけて100%の変換率を
目指していこうと思います。
この度は本当に、どうもありがとうございました。