読者です 読者をやめる 読者になる 読者になる

Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。Word VBAも始めました。

化学式の分解② つづいた

chemiphys.hateblo.jp
さて,昨日とりあえずそれっぽい形にしたものの,スマートではないよなぁとは思っていました。

すると,このようなご指摘をいただきました。

id:imihito
上付き下付きなどの書式を維持して文字を操作したい場合は、Runsで分解したTextRangeに対して操作するとうまくいくと思います。

私の場合だと、思考停止して正規表現でやってしまうかもです。
Sub RegExpText()

Const ChkTxt$ = "10Na2HC4O3"

Dim matchCol As Object 'As VBScript_RegExp_55.MatchCollection
With VBA.CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "([0-9]+|[A-Z][a-z]?)"
Set matchCol = .Execute(ChkTxt) '←中身確認
Stop
End With

End Sub

正規表現どこかで聞いたことはあります。でも,私が知らない領域。

書いてもらったコードを動かしてみると確かにすごい。どんどん分けてくれている。

ふむふむ すごいなぁ。。じゃ,利用させてもらって,さらに ()がつくメンドクサイ化学式もがんばってみよう。

Cu(NO3)2みたいにめんどくさいやつです。

括弧をどうにかしてやろうとか思わなければ,比較的簡単でしたが,括弧の処理は,けっこう私の手に余る内容でした。

ただ,Powerpoint VBAでデータを多数扱おうとするなら配列は便利なものですし,配列でなんかごちゃごちゃやってるなぁというのを見るだけでも,

何かのきっかけになるかもなぁと 形になっただけで,きちんとは考えられていないものですが載せてみます。

形にするだけでも,苦戦しました(;´▽`A``

f:id:chemiphys:20170119222137p:plain
スライド1にTableという表を入れていただいて,一番上の行に化学式を入れます。

そして,下記のコードを実行してみると,表が図のようにうまる・・はず。

正規表現部分は一応ネットで調べたものの,まだ私はわかっていません。

imihitoさんに教えていただいたものをちょこっとだけいじって ( と ) も出力するように変えただけです。

Option Explicit

Sub RegExpText()
Dim TSlide As Slide: Set TSlide = ActivePresentation.Slides(1)
Dim tblChemicals As Table: Set tblChemicals = TSlide.Shapes("Table").Table

Dim ChkTxt As String
Dim colChemicals As Collection
Dim matchCol As Variant 
Dim i As Long, j As Long, k As Long, l As Long
Dim 係数 As Long, 括弧 As Long
Dim buf(0 To 10, 1 To 3) As String
Dim Chem(1 To 10) As Variant
For i = 1 To tblChemicals.Columns.Count
    ChkTxt = tblChemicals.Cell(1, i).Shape.TextFrame.TextRange
    
    With VBA.CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([0-9]+|[A-Z][a-z]?)|\(|\)"
        Set matchCol = .Execute(ChkTxt)
    End With
    If IsNumeric(matchCol(0)) = True Then
        係数 = matchCol(0)
        j = 1
    Else
        係数 = 1
        j = 0
    End If
    buf(0, 1) = 係数
    
    k = 1
    括弧 = 1
    Do
        If matchCol(j) = "" Then Exit Do
        If matchCol(j) = "(" Then
            l = 0
            Do
            l = l + 1
            Loop Until matchCol(j + l) = ")"
            括弧 = matchCol(j + l + 1)
            
        ElseIf matchCol(j) = ")" Then
            括弧 = 1
            j = j + 1
        ElseIf IsNumeric(matchCol(j)) = False Then
            buf(k, 1) = matchCol(j)
            If j = matchCol.Count - 1 Then
                buf(k, 2) = "1"
                buf(k, 3) = 括弧
            ElseIf IsNumeric(matchCol(j + 1)) = False Then
                buf(k, 2) = "1"
                buf(k, 3) = 括弧
            End If
        ElseIf IsNumeric(matchCol(j)) = True Then
            buf(k, 2) = matchCol(j)
            buf(k, 3) = 括弧
        Else
            Debug.Print j; " "; k; " "; matchCol(j)
        End If
        
        If buf(k, 2) <> "" Then k = k + 1
        j = j + 1
    Loop Until j = matchCol.Count
            
    
Chem(i) = buf
Erase buf
Next

For i = 1 To tblChemicals.Columns.Count
    tblChemicals.Cell(2, i).Shape.TextFrame.TextRange = "係数" & Chem(i)(0, 1)
    j = 1
    Do While Chem(i)(j, 1) <> ""
        tblChemicals.Cell(j + 2, i).Shape.TextFrame.TextRange.Text = Chem(i)(j, 1) & " " & CLng(Chem(i)(j, 2)) * CLng(Chem(i)(j, 3)) & "個"
        j = j + 1
    Loop
Next
End Sub

これをスマートに書けたら,何かで使えるかもしれないんだけどなぁ。

先は長いね(ΦωΦ)