Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。AdobeのScriptにも興味が少し。。

同じ順番で現れる 不特定桁の数値の比較をしてみる。

反応式の奴は落ち着いたんですが,一度できたあとも改善できないか遊んでいたら,記事になりそうでしたので書いてみています。

まずは準備のコード。

Sub 準備()
    Dim TSld As Slide: Set TSld = ActivePresentation.Slides(1)
    With TSld.Shapes.AddLabel(msoTextOrientationHorizontal, 0, 50, 300, 50)
        With .TextFrame
            .AutoSize = ppAutoSizeNone
            With .TextRange
                .Text = "H 4,S 100,Cl 1,Mn 3"
                .Font.Color.RGB = rgbBlack
            End With
        End With
        .Line.ForeColor.RGB = rgbBlack
        .Line.Weight = 2
        .Name = "Label1"
    End With
    
    With TSld.Shapes.AddLabel(msoTextOrientationHorizontal, 0, 200, 300, 50)
        With .TextFrame
            .AutoSize = ppAutoSizeNone
            With .TextRange
                .Text = "H 8,S 9,Cl 5,Mn 3"
                .Font.Color.RGB = rgbBlack
            End With
        End With
        .Line.ForeColor.RGB = rgbBlack
        .Line.Weight = 2
        .Name = "Label2"
    End With
End Sub

これを実行すると,
f:id:chemiphys:20181019191143p:plain
二つのテキストボックスを挿入し,中に元素記号と数字が並んでいる状態になると思います。
S 100 とかあほな数字を書いていますが,まぁ桁をずらしたかっただけです。

さて,この数字部分だけが等しいかどうかを判別し,異なる場合は色をつける。

こういうことをしようとすると,普通にやるとまぁまぁ面倒になるんじゃないかと思います。

簡単な正規表現を使ってそれを処理したのが次のコード

Sub 照合()
    Dim TSld As Slide: Set TSld = ActivePresentation.Slides(1)
    Dim Lbl1 As TextRange: Set Lbl1 = TSld.Shapes("Label1").TextFrame.TextRange
    Dim Lbl2 As TextRange: Set Lbl2 = TSld.Shapes("Label2").TextFrame.TextRange
    
    'Microsoft VBScript Regular Expression 5.5への参照設定が必要です
    Dim Reg As New RegExp, Mat1 As MatchCollection, Mat2 As MatchCollection
    
    With Reg
        .Global = True
        .Pattern = "[0-9]+"
        Set Mat1 = .Execute(Lbl1.Text)
        Set Mat2 = .Execute(Lbl2.Text)
    End With
    
    Lbl1.Font.Color.RGB = rgbBlack
    Lbl2.Font.Color.RGB = rgbBlack
    Dim i, Arr As Variant
    Arr = Array(rgbRed, rgbBlue, rgbYellow, rgbPink, rgbGreen)
    
    For i = 0 To Mat1.Count - 1
        If Mat1(i) <> Mat2(i) Then
            Lbl1.Characters(Mat1(i).FirstIndex + 1, Mat1(i).Length).Font.Color.RGB = Arr(i)
            Lbl2.Characters(Mat2(i).FirstIndex + 1, Mat2(i).Length).Font.Color.RGB = Arr(i)
        End If
    Next

End Sub

いつも通り,RegExpを使うために参照設定が必要です。コメントで書いてます。実行速度にも影響がありますし,わたしは事前バインディングしか使わない派です。

正規表現のバターンは非常に簡単。 0-9 の数字が一回以上あるのを捕まえる,というように書いています。
照合 マクロを実行すると,
f:id:chemiphys:20181019191628p:plain

このようになります。
それぞれの文字列に対し,正規表現を適用し,マッチコレクションをMat1,Mat2放り込んでいます。

f:id:chemiphys:20181019192026p:plain
こんな感じで格納されているので,比較して,違ったらFirstIndexとLengthを使って指定し,色を変えています。

私がやる操作って,こういう類のものが多い気がするので,今後も使っていけそうな感じでした。