Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。JavaScriptやJScript,HTAに最近はまってます。

化学反応式(5)?

さて,そろそろこの話も終わらないと。

いろいろと勉強にはなりました。まず,VBScript正規表現は後読みとかそういうのが無いらしいこと。

できることだけやるしかないようですね。当たり前ですが(;´▽`A``

妥協点を考える。

わたしがやりたかったのは「化学反応式中の添え字の数字の位置を知りたい」という点です。位置だけを効率よく抜き出したい。

各元素の数等については,十分満足がいくレベルに来ていたので,下付け文字にするための位置を知りたかった。

以前,4択問題集とかを作った際,化学の教材で上付き下付きを無視するのはありえない,という持ち科目による自己制限を課して,克服すべくやっていました。

ForNext等を利用し,やれてはいたものの,そこで立ちふさがったのが,処理速度の問題でした。

あまり速度が速くないタブレットで十分使えるレベルを目指す,となったとき,もともとプログラミングでごりごり画像を扱うというソフトではないパワーポイントでは,

もっさりした動きがどうしても出たんです。それが理由で,ループを減らして実現したいというマニアックな制限下での取り組みです。

なので,偏っていることは承知の上(;´▽`A`` もうあきらめようとしていましたが,どうも私の記事をきっかけにいろいろと試してもらっていただいたようでしたので,

もうちょい自分も考えてみようと思いました。

infoment.hatenablog.com

Infoment さんありがとうございます。

さて,本題の位置決めです。VBScript正規表現に制限があろうと,それでも極めて優秀なのは間違いないので,自分の発想を柔軟にするべきとまず思いました。

そこでとりあえず候補になってるのが下記のコード Microsoft VBScript Regular Expression 5.5への参照設定を前提としています。

Sub test()
    Dim Reg As New RegExp, Matches As MatchCollection, Str_ As String

    Str_ = "3MnO2+4HCl→5MnCl2+2H2O+Cl20" '化学反応式はわざとめちゃくちゃです。
                                          'うまく引掛けてるかどうかの確認のため。
    With Reg
        .Global = True
        .Pattern = "[A-Za-z]([0-9]+)"
        Set Matches = .Execute(Str_)
    End With
    Stop


End Sub

とても短いです(;´▽`A``

ローカルウィンドウではこんな感じ
f:id:chemiphys:20181009224956p:plain

本当は,数字の位置だけを一発で取り出したいわけですが,わたしの今の能力ではその前のアルファベットまで引掛けてしまいます。

そこをウンウン悩んでいたんですが,位置を知りたいだけなので,一文字だけ確実にひっかけてくるように考えれば位置はわかるじゃないか,というけっこう適当な発想をしてみました。

1文字確実にひっかけるなら1文字ずらせば位置は特定できますもんね。。

正規表現でひっかけたものは, FirstIndexのところに何文字目にあるかを情報として与えてくれます。なので,それ+1した数字のところが,添え字のスタート地点だといえます。

次にまれに二桁の添え字がある( P4O10みたいな)それを判別するには・・
( )を正規表現で使っているのでSubmatchesを利用することで解決できるのが一つ。まず私はそれを考えていました。でも,それじゃないね。

Item4のところを見るとわかるんですが,二桁の添え字をひっかけると,ちゃんとLengthのとこが3になっています。通常は2で二けた引掛けたときは3に。

きちんと規則正しく言うことを聞いてくれているので,どうもこれで必要な情報は得られている模様。

ふむふむ これはよさそう。FirstIndexは0文字目から数えているのかな。。ということは結局二つずらせばいいかなーと思い,次のコードになります。

Sub test()
    Dim Reg As New RegExp, Matches As MatchCollection, Str_ As String

    Str_ = "3MnO2+4HCl→5MnCl2+2H2O+Cl20" '化学反応式はわざとめちゃくちゃです。
                                          'うまく引掛けてるかどうかの確認のため。
    With Reg
        .Global = True
        .Pattern = "[A-Za-z]([0-9]+)"
        Set Matches = .Execute(Str_)
    End With

    
    Sheet1.Cells(1, 1) = Str_
    Sheet1.Cells(1, 1).Font.Subscript = False
    Dim i
    For i = 0 To Matches.Count - 1
        Sheet1.Range("a1").Characters(Matches(i).FirstIndex + 2, Matches(i).Length - 1).Font.Subscript = True
    Next

End Sub


肝は
Sheet1.Range("a1").Characters(Matches(i).FirstIndex + 2, Matches(i).Length - 1).Font.Subscript = True
ここのところ。かなりすっきり書けた。

結果は (化学反応式は嘘ものですから!!そこの突っ込みはご遠慮します。)

f:id:chemiphys:20181009230500p:plain

これは満足できそうな結果に思えます。よさそう。。

---
本当は化学反応式を図示するやつは作っちゃったんですが,

県の教職員が自作の教材を提出してみてね。公開したやつはだめですよ。

という内容のものに,たまには出してみようと思って作ってたやつなので,残念ながらしばらく作ったもの自身をここに上げることはできません。

その会が終わった後,全部のコードを載せようと考えているところです。

画面構成等もVBAコードで書いて作ったので,コード載せるだけできちんと自分のやりたかったものは伝えれる仕上がりにはなったと思います。

3日しかかけてないので,穴だらけかもしれませんが・・素人なのでそこは許してもらえるはず。

期間が無かったので作ったものはささっと送ってしまいました。。

でも,そこで使っている下付きのコードは今回のコードではありません。

あきらかにこっちが効率いい。・・・あの時は思いつけなかった。。

でも,話のネタにしてもらったことがきっかけでもう一度考えてみることで自分なりには満足いくコードになったので,とても勉強になりました。

ありがたかったです。このコードは今後に生きるなぁ。

そうそう忘れていました。今回の内容ではあまり大差はないんですが,今回素直に言うことを聞いてくれるExcel のほうのVBAで書いています。

ただ,最後らへんのSheet1・・・ あたりを Activepresentation.Shapes("~").TextFrame.TextRange・・・とかにしていくだけでパワーポイントにも適応できます。

題名詐欺になってました(;´▽`A``そのうちちゃんと対応しないとかな。。いつか余裕があればパワーポイント仕様に・・。

追記しまくりですが,パワーポイント版
Microsoft VBScript Regular Expression 5.5への参照設定が必要です。(レイトバインディング嫌いなんです。ごめんなさい)

Sub test()
    Dim Reg As New RegExp, Matches As MatchCollection, Str_ As String

    Str_ = "3MnO2+4HCl→5MnCl2+2H2O+Cl20" '化学反応式はわざとめちゃくちゃです。
                                          'うまく引掛けてるかどうかの確認のため。
    With Reg
        .Global = True
        .Pattern = "[A-Za-z]([0-9]+)"
        Set Matches = .Execute(Str_)
    End With

    
    With ActivePresentation.Slides(1).Shapes.AddLabel(msoTextOrientationHorizontal, 0, 0, 200, 50)
        With .TextFrame
            .AutoSize = ppAutoSizeNone
            With .TextRange
                .Text = Str_
                .Font.Subscript = False
                Dim i
                For i = 0 To Matches.Count - 1
                    .Characters(Matches(i).FirstIndex + 2, Matches(i).Length - 1).Font.Subscript = True
                Next
            End With
        End With
    End With
End Sub

ブログ名前詐欺回避(ΦωΦ)