Powerpoint VBAを使おう!

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

正規表現5回目くらい

化学式の分解,まだやっています。
Replaceメソッドと戯れているところ。想定通りの動きをさせられません。

Replaceメソッドを以前載せたものに加えたうえで,挙動を載せてみます。

Word,Excel,Powerpoint どれでも動きます。
WordはNormalテンプレートが邪魔なので,ExcelかPowerpointでの実行がおすすめかなぁ。

実行結果

コードは後で載せます。

必要な部分だけピックアップしますが,複塩の化学式を試しに使いました。括弧が複雑に入っています。

※化学式の(NH4)3の部分は本来は(NH4)2だったんですが,Replaceの機能を確認するためにわざと(NH4)3にしています。

ChemicalString = "(NH4)3Fe(SO4)2・6H2O "

RE.Pattern_ = "\((.+?)\)([0-9]+)"

f:id:chemiphys:20170312215906p:plain
捉えたい情報はしっかりとれています。

でも,これに次のようにReplaceメソッドを使うと,

?RE.Replace_(ChemicalString, "$1$1")
↓
NH4NH4FeSO4SO4・6H2O 
?RE.Replace_(ChemicalString, "$1$2")
↓
NH43FeSO42・6H2O 

と出力します。上記のように,イミディエイトウィンドウに Replace_メソッドを直接かけるので,いろいろチェックは簡単です。(Public様々)

それぞればらばらにちゃんと取得できているのに,別々に置換設定できない。
できないというか,やり方がわからない・・

とても面白い挙動はしていますけど・・。せっかくクラスモジュールでラップしたので,自分好みのReplace2メソッドを実装するほうがいいのかな(ΦωΦ)

その辺好き勝手できるのがクラスモジュールのいいところですね。

今は元の機能をあまり変えたくない,メソッド名なども極力変えたくないという気持ちがあるので,これ以上はいじりませんが,今度本格的に化学反応式を好き勝手に分解して利用するときには,完全に自分仕様のクラスモジュールに書き換えていきたいと思います。

正規表現モジュールとはけっこう楽しく遊べました。また,近いうちに扱いたいと思います。

コードを載せておきます。

標準モジュール

Option Explicit

Public RE As RegExpClass

Sub test()
Set RE = New RegExpClass

Dim ChemicalString As String
ChemicalString = "(NH4)3Fe(SO4)2・6H2O "
RE.sourceString_ = ChemicalString
RE.Pattern_ = "\((.+?)\)([0-9]+)"

Debug.Print RE.Execute_

Debug.Print RE.Replace_(ChemicalString, "$1$1")

End Sub

クラスモジュール


RegExpClass.cls

Option Explicit

Private pPattern As String
Private pIgnoreCase As Boolean
Private pGlobal As Boolean
Private pSourceString As String
Private pMatchCollection As Object
Private pSubMatches As Variant

Property Let Pattern_(Optional argIgnoreCase As Boolean = False, Optional argGlobal As Boolean = True, argPattern As String)
    pPattern = argPattern
    pIgnoreCase = argIgnoreCase
    pGlobal = argGlobal
End Property

Property Let IgnoreCase_(argIgnoreCase_ As Boolean)
    pIgnoreCase = argIgnoreCase
End Property
Property Get IgnoreCase_() As Boolean
    IgnoreCase_ = pIgnoreCase
End Property

Property Let Global_(argGlobal As Boolean)
    pGlobal = argGlobal
End Property
Property Get Global_() As Boolean
    Global_ = pGlobal
End Property

Property Let sourceString_(argSourceString As String)
    pSourceString = argSourceString
End Property
Property Get sourceString_() As String
    sourceString_ = pSourceString
End Property

Property Get MatchCollection_() As Object
    Set MatchCollection_ = pMatchCollection
End Property

Property Get SubMatches_() As Variant
    SubMatches_ = pSubMatches
End Property

Function Execute_() As String
    On Error GoTo Err:
    Dim ret As String
    
    'Dim Regex As VBScript_RegExp_55.RegExp
    'Set Regex = New VBScript_RegExp_55.RegExp
    Dim Regex As Object
    Set Regex = CreateObject("VBScript.RegExp")
    
    
    With Regex
        .Pattern = pPattern
        .IgnoreCase = pIgnoreCase
        .Global = pGlobal
        Set pMatchCollection = .Execute(pSourceString)
    End With
    
    Dim s
    
    For Each s In pMatchCollection
        ret = ret & "," & IIf(s = "", Chr(34) & Chr(34), s)
    Next
    Execute_ = pMatchCollection.Count & "個Hit" & vbCrLf & Mid(ret, 2)
    
    If pMatchCollection.Count = 0 Or pMatchCollection(0).SubMatches.Count = 0 Then
        Erase pSubMatches
        Exit Function
    End If
    
    ReDim pSubMatches(0 To pMatchCollection.Count - 1, 0 To pMatchCollection(0).SubMatches.Count - 1) As String
    Dim i As Long: i = 0
    Dim j As Long
    Dim s2
    For Each s In pMatchCollection
        j = 0
        For Each s2 In s.SubMatches
            pSubMatches(i, j) = s2
            j = j + 1
        Next
        i = i + 1
    Next
    Exit Function
Err:
Call ErrMsg(Err)
End Function

Sub ErrMsg(argErr As Long)
    Select Case argErr
        Case 5017
            MsgBox ("アプリケーション定義またはオブジェクト定義エラーです。" & Chr(10) & _
            "正規表現部分の文法を見直してみてください。")
    End Select
End Sub

Function Replace_(argSourceString As String, argReplaceVar As Variant) As String
    On Error GoTo Err:
    Dim ret As String
    
    'Dim Regex As VBScript_RegExp_55.RegExp
    'Set Regex = New VBScript_RegExp_55.RegExp
    Dim Regex As Object
    Set Regex = CreateObject("VBScript.RegExp")
    
    
    With Regex
        .Pattern = pPattern
        .IgnoreCase = pIgnoreCase
        .Global = pGlobal
    End With

    Replace_ = Regex.Replace(argSourceString, argReplaceVar)
Exit Function
Err:
Call ErrMsg(Err)

End Function