こんにちは！なるーらぼです！
前回に引き続き、PowerPointのマクロであそんでみたいと思います。

今回はよくあるのかどうかわかりませんが、あるキーワードがプレゼンテーション中にあったら色付けしたりボールド（太字）にしたりしてハイライトするというのをやってみたいと思います。

プログラミングをお仕事でも趣味でもされる方は、スライドにコードを貼り付けたりすることが頻繁にあると思います。しかし、HTMLとは違ってプログラムコードの構文をハイライトしてくれるほどPowerPointは優しくありません：）

キーワードを見つける

こんなパワポのスライドがあったとしましょう。

スクリーンショットを貼り付けてから気づきましたが、「あなたの」ではなくて「あなたと」でしたね…

「PowerPoint」というキーワードをハイライトして「俺だーっ！！」という感じにしたいとしたら。そのときはこのスライドから「PowerPoint」というキーワードを見つける必要があります。

前回も登場しましたが、TextFrame.TextRange.Textが実際の文字部分を表すので、この文字列を取り出してごにょごにょするように思えます。しかし、もっと便利なものがありまして、それがTextRangeオブジェクトのFindメソッドです。

Findメソッドは一つ目の引数に探したいキーワードを文字列で指定します。あとは任意の引数です。二つ目が検索を開始する場所、三つ目が大文字小文字を分けて検索するか、四つ目がキーワード全体が一致したものだけにするかどうかです。

Sub powerpo()
　Dim s As Slide
　Dim sh As Shape
　Dim tr As TextRange
　Dim fr As TextRange
　
　Set s = Presentations(1).Slides(1)
　For Each sh In s.Shapes
　　If sh.HasTextFrame Then
　　　Set tr = sh.TextFrame.TextRange
　　　Set fr = tr.Find("PowerPoint", , msoTrue)
　　　If not (fr Is Nothing) Then
　　　　With fr
　　　　　.Font.Bold = msoTrue
　　　　　.Font.Underline = msoTrue
　　　　　.Font.Color.RGB = RGB(0, 0, 160)
　　　　End With
　　　End If
　　End If
　Next
End Sub

ちょっと長いですが、スライド１の図形すべてにおいて行っているためです。
さらに、図形にテキストを入れる場所があるかどうかをチェックする必要がありますのでHasTextFrameプロパティがTrueのときだけ後の処理をするようにしてあります。

検索してみつかったらTextRangeオブジェクトが返されます。見つからない場合はNothingになるので見つかったかどうかはこれで確認することができます。あとは見つかった範囲がTextRangeになっているので太字にしたり下線を引いたり、色を変えたり…ということが可能になります。

ただ、上記のコードを実行してみると各図形で最初に見つかったキーワードしかハイライトされません。

ひとつのテキストボックス内にキーワードが１つ以上あるときにも対応したいとしたら、見つからなくなるまで検索を繰り返せばいいですね。

Sub powerpo()
　Dim s As Slide
　Dim sh As Shape
　Dim tr As TextRange
　Dim fr As TextRange
　
　Set s = Presentations(1).Slides(1)
　For Each sh In s.Shapes
　　If sh.HasTextFrame Then
　　　Set tr = sh.TextFrame.TextRange
　　　Set fr = tr.Find("PowerPoint", , msoTrue)
　　　Do Until (fr Is Nothing)
　　　　With fr
　　　　　.Font.Bold = msoTrue
　　　　　.Font.Underline = msoTrue
　　　　　.Font.Color.RGB = RGB(0, 0, 160)
　　　　　Set fr = tr.Find("PowerPoint", .Start + .Length - 1, msoTrue)
　　　　End With
　　　Loop
　　End If
　Next
End Sub

ポイントは「Do Until (fr Is Nothing)」で見つからなくなるまでという条件の反復を行っているところ、そしてハイライト処理を終えたところで見つけた位置(TextRange.Startプロパティ)から見つかったキーワードの文字長(TextRange.Lengthプロパティ)を使って次に検索を開始する位置を指定している「Set fr = tr.Find("PowerPoint", .Start + .Length - 1, msoTrue)」というところです。

これによって各テキストボックスともにキーワードがハイライトされます。

これで特定のキーワードをハイライトする、ということはできました！

コードを構文ハイライトする

ここまで来たら、簡易な構文ハイライトもやってみたいですよね！では次のようなスライドがあったとしましょう。

簡単なルールを決めています。[code]:というキーワードがあるテキストボックスでは構文ハイライトをすることにします。キーワードがあるかどうかは先ほどの応用で、Findメソッドを使えばいいですね。問題はその後です。

さきほどはキーワードが１つでしたが、今度は複数あります。そうした場合には配列で指定してしまうのも手でしょうし、別のファイルなどに定義しておいてもいいでしょう。ここでは配列を使うことにします。

やたらとインデントが深くなるので、ハイライトする部分はサブルーチンにわけてみます。「Highlighting」というサブルーチンで、引数にTextRangeオブジェクトをとります。こうしておくと、[code]:というキーワードが存在するテキストボックスだけにハイライトを適用することができますよね。

Sub Highlighting(tr As TextRange)
　Dim fr As TextRange
　Dim keyword As Variant
　Dim i As Long
　keyword = Array("Function", "Sub", "If", "End", "As", "Dim", "Then")
　If tr Is Nothing Then Exit Sub
　
　For i = LBound(keyword) To UBound(keyword)
　　Set fr = tr.Find(keyword(i), , msoTrue)
　　Do Until (fr Is Nothing)
　　　With fr
　　　　.Font.Bold = msoTrue
　　　　.Font.Color.RGB = RGB(0, 0, 160)
　　　　Set fr = tr.Find(keyword(i), .Start + .Length - 1)
　　　End With
　　Loop
　Next
End Sub

ここでは「Function」「Sub」「If」「End」「As」「Dim」「Then」だけに対応します。これらを配列として指定しています。
次に渡されたTextRangeがNothingのときは処理を中断するようにしてあります。

If tr Is Nothing Then Exit Sub

あとはキーワードの数だけ反復するのですが、さらに与えられたTextRangeオブジェクト内で見つかるだけハイライトを繰り返しています。こうすることでキーワードに合致するものすべてにハイライトを適用することができます。

このサブルーチンを呼び出す側はこのようにしてあります。

Sub note_mu()
　Dim s As Slide
　Dim sh As Shape
　Dim tr As TextRange
　
　For Each s In Presentations(1).Slides
　　For Each sh In s.Shapes
　　　If sh.HasTextFrame Then
　　　　Set tr = sh.TextFrame.TextRange
　　　　If Not (tr.Find("[Code]:") Is Nothing) Then
　　　　　Highlighting tr
　　　　End If
　　　End If
　　Next
　Next
End Sub

これを実行すると…

いいですね！元に戻すときは「元に戻す」で一発です！
せっかくなのでイコール記号などの演算子もやってみましょう。

Sub Highlighting(tr As TextRange)
　Dim fr As TextRange
　Dim keyword As Variant
　Dim operator As Variant
　Dim i As Long
　keyword = Array("Function", "Sub", "If", "End", "As", "Dim", "Then")
　operator = Array("=", "<", ">", "+", "-", "*", "/", "%")
　If tr Is Nothing Then Exit Sub
　
　For i = LBound(keyword) To UBound(keyword)
　　Set fr = tr.Find(keyword(i), , msoTrue)
　　Do Until (fr Is Nothing)
　　　With fr
　　　　.Font.Bold = msoTrue
　　　　.Font.Color.RGB = RGB(0, 0, 160)
　　　　Set fr = tr.Find(keyword(i), .Start + .Length - 1)
　　　End With
　　Loop
　Next
　For i = LBound(operator) To UBound(operator)
　　Set fr = tr.Find(operator(i), , msoTrue)
　　Do Until (fr Is Nothing)
　　　With fr
　　　　.Font.Bold = msoTrue
　　　　.Font.Color.RGB = RGB(160, 0, 32)
　　　　Set fr = tr.Find(operator(i), .Start + .Length - 1)
　　　End With
　　Loop
　Next
End Sub

うん、同じ内容を別の配列でやっているだけですね！別のサブルーチンに分けることもできそうです。

うーん、わかりづらい。

文字列部分のハイライト

最後にダブルクォーテーションで囲まれた文字列をハイライトすることを考えてみます。いままではキーワードが決まっていたので配列に入れて反復していました。しかし、ダブルクォーテーションで囲まれたというのは配列に入れておくことはできません。

そこで、正規表現を使ってみたいと思います。以前の投稿「もっと文字列であそぼう」のときにご紹介したものですね。

正規表現を利用するには参照設定で「Microsoft VBScript Regular Expressions x.x」にチェックを入れましょう。

必要な変数が3つあります。

Dim exp As RegExp
Dim m As MatchCollection
Dim t As Match

１つは正規表現エンジンそのもの「RegExp」、2つ目はピックアップされた部分の集合を表す「MatchCollection」、3つ目はピックアップされた部分を表す「Match」です。

Set exp = New RegExp
exp.Pattern = Chr(34) & "\S+" & Chr(34)
exp.Global = True
exp.Multiline = True

パターンはダブルクォーテーションで囲まれた空白以外の文字が1つ以上連続しているところ、としています。
また、対象は与えられた文字列全体（exp.Global = True）、複数行になっている対象である（exp.Multiline = True）とします。

あとはTextRange.Textプロパティで文字列を与えて、合致する部分をピックアップします。

Set m = exp.Execute(tr.Text)
If m.Count = 0 Then Exit Sub

まったくヒットしなければコレクションの数（MatchCollection.Count）はゼロになるので処理を中断してもいいでしょう。あとは存在するだけピックアップされたものをイミディエイトウィンドウにでも出力するとうまくいっているか確認できます。

For Each t In m
　Debug.Print t.Value
Next

しかし、これでピックアップされてきたものをどうするのでしょうか？
ここでは文字列として手に入るのでこれをキーワードとして検索に利用すれば簡単ですね。

先ほどのループをこんな感じにすればハイライトすることができます。

For Each t In m
　Set fr = tr.Find(t.Value)
　With fr
　　.Font.Bold = msoTrue
　　.Font.Color.RGB = RGB(0, 160, 0)
　　Set fr = tr.Find(t.Value, .Start + .Length - 1)
　End With
Next

こうしてみていただくと、スライドの見出しにもキーワードの「If」がありますがハイライトされず、[code]:が入っているテキストボックスだけに適用されていることがおわかりでしょう。

問題点

なお、今回ご紹介する正規表現は２つ問題があります。

一つ目の問題はダブルクォーテーションで囲まれた中に空白が入るとハイライトされなくなるというものです。空白以外の文字の繰り返しを想定しているので、空白があるとピックアップされなくなってしまうのです。

二つ目の問題はダブルクォーテーションです。PowerPointでダブルクォーテーションを記述するとコード中のダブルクォーテーション、Chr(34)で表現されるものとは異なる文字が使用されます。よって、コードをソースコードからの貼り付けではなくPowerPoint内で編集した場合にうまくピックアップすることができません。

最後に

今回はテキストボックス中のキーワードをハイライトしてあそんでみました。もしかしたら意外と便利なのでは？と思ったくらいです！

今回のコード全体をGistにおいておきますが、コピペが面倒だと思う方もいらっしゃるかと思います。試験的に今回はファイルごと配布してみようと思います。なお、リンク部分だけ有償にさせていただきます。ダウンロードしてあそんでみてください。不明点ありましたらコメント等でお願いします。

↓　↓