今回は、Withを使ったコードをWith無しのコードに変換するマクロを作ってみる。
何の役に立つんだというツッコミはなしで。
目次
マクロの概要
変換のターゲットとするコードはこちら。
Sub hoge() Dim R As Range Set R = Selection With R .HorizontalAlignment = xlCenter .Value = "ABC" .Interior.Color = vbYellow With .Font .Color = vbRed .Bold = True End With With .Borders .LineStyle = xlContinuous .Color = vbBlue End With End With End Sub
上記のコードを、マクロを使って以下のように変換する。
Sub hoge() Dim R As Range Set R = Selection R.HorizontalAlignment = xlCenter R.Value = "ABC" R.Interior.Color = vbYellow R.Font.Color = vbRed R.Font.Bold = True R.Borders.LineStyle = xlContinuous R.Borders.Color = vbBlue End Sub
実現方法を検討する
さて、どう実現するのか。
まず、コードはクリップボードから読み込み、イミディエイトウインドウに出力することにしよう。
VBAでクリップボードを扱うには、「Microsoft Forms 2.0 Object Library」を参照設定する必要がある。
あるいは、ユーザーフォームを挿入すると自動で参照設定される。
とりあえず、クリップボードにコピーしたコードをそのままイミディエイトウインドウに出力するコードを書いてみた。
ポイントは改行でSplitして配列Arrに格納しているところ。
Sub とりあえず入出力() Dim CB As New DataObject CB.GetFromClipboard Dim Arr() As String: Arr = Split(CB.GetText, vbCrLf) Dim s For Each s In Arr Debug.Print s Next End Sub
次にWithで始まる文はそのまま出力せず、オブジェクト名を保持するように変更する。
そして、ドットで始まる文の先頭にオブジェクト名を付けていけばよい。
その通りに作ってみた。
Sub Withを外す() Dim CB As New DataObject CB.GetFromClipboard Dim Arr() As String: Arr = Split(CB.GetText, vbCrLf) Dim s For Each s In Arr If Left(Trim(s), 4) = "With" Then ObjectName = Right(Trim(s), Len(Trim(s)) - 5) ElseIf Left(Trim(s), 1) = "." Then Debug.Print ObjectName & Trim(s) ElseIf Trim(s) = "End With" Then '何もしない Else Debug.Print s End If Next End Sub
これで単体のWithならうまくいく。
ためしに以下をコピーして実行してみると、
Sub hoge() Dim R As Range Set R = Selection With R .HorizontalAlignment = xlCenter .Value = "ABC" .Interior.Color = vbYellow End With End Sub
このように、Withが外れて出力される。
Trimしているためインデントが消えているが、とりあえずできている。
しかし、冒頭のターゲットコードに対して実行してみるとうまくいかない。
入れ子になったWithの扱い方
Withが入れ子になっているコードにも対応させるべく、状態遷移図を使って考えてみよう。
まずWith文の外側をNoWithと定義する。
以下は、WithやEnd Withが実行されるたびにどのように状態が変化するのかを図示したものである。
図中の「With R」は、「With Rの内部にいる状態」を表す。
1 | With R | 進む |
2 | With .Font | 進む |
3 | End With | 戻る |
4 | With .Borders | 進む |
5 | End With | 戻る |
6 | End With | 戻る |
このように、行って戻ってくるような構造の場合、スタックを使って処理することができる。
スタックとは、下から上にデータを積み上げていく構造で、常に一番上のデータだけを取り出すことができる。
図示すると次のとおり。
1 | With R | 積む |
2 | With .Font | 積む |
3 | End With | 降ろす |
4 | With .Borders | 積む |
5 | End With | 降ろす |
6 | End With | 降ろす |
VBAでスタックを実装
以前VBAでスタッククラスを作成したので、そちらを使いまわすことにした。
クラスモジュールを挿入し、オブジェクト名をStackとして以下のコードを張り付ける。
Private Items() As Variant Property Get Count() As Integer Count = UBound(Items) End Property Property Get Top() As Variant Top = Items(UBound(Items)) End Property Public Function Pop() As Variant If UBound(Items) > 0 Then Pop = Items(UBound(Items)) ReDim Preserve Items(UBound(Items) - 1) Else Pop = Empty End If End Function Public Sub Push(ByRef x As Variant) ReDim Preserve Items(UBound(Items) + 1) Items(UBound(Items)) = x End Sub Private Sub Class_Initialize() ReDim Items(0) End Sub
スタックに積む操作をPush、降ろす操作をPopという。また、Top命令で一番上のデータを参照することができる。
実際にサンプルを書いて見た。
Sub StackTest() Dim ObjectStack As New Stack ObjectStack.Push "R" Debug.Print ObjectStack.Top & ".Test1" ObjectStack.Push "R.Font" Debug.Print ObjectStack.Top & ".Test2" ObjectStack.Pop Debug.Print ObjectStack.Top & ".Test3" ObjectStack.Push "R.Borders" Debug.Print ObjectStack.Top & ".Test4" ObjectStack.Pop Debug.Print ObjectStack.Top & ".Test5" ObjectStack.Pop End Sub
実行するとこのように、スタックの先頭データと".TextX"が結合されて出力される。
R.Test1 R.Font.Test2 R.Test3 R.Borders.Test4 R.Test5
スタックを使ったWithを外すコード
前項で紹介したスタックを使ってWithを外すコードを作成する。
With文が出てきたらスタックにオブジェクト名をPushし、End Withが出てきたらPopすれば良い。
完成したコードがこちら。
Sub UnWith() Dim CB As New DataObject CB.GetFromClipboard Dim Arr() As String: Arr = Split(CB.GetText, vbCrLf) Dim ObjectStack As New Stack '先に配列内の値をすべてトリムしておく Dim i For i = LBound(Arr) To UBound(Arr) Arr(i) = Trim(Arr(i)) Next Dim s, ObjectName For Each s In Arr If Left(s, 4) = "With" Then ObjectName = Right(s, Len(s) - 5) If Left(ObjectName, 1) = "." Then ObjectStack.Push ObjectStack.Top & ObjectName Else ObjectStack.Push ObjectName End If ElseIf Left(s, 1) = "." Then Debug.Print ObjectStack.Top & s ElseIf s = "End With" Then ObjectStack.Pop Else Debug.Print s End If Next End Sub
実行結果はこの通り
課題
インデントが消えてしまうのが難点だが、以前に自動でインデントを揃えるマクロを紹介したのでそれと組み合わせれば綺麗に作れそうだ。
thom.hateblo.jp
また、今回作成したUnWithマクロの課題として、ドットが文の中ほどにあるものは対応していない。
たとえば、選択されている四角いシェイプの面積を求める以下のマクロをコピーして実行すると、
Sub 四角いシェイプの面積() Dim S As Shape Set S = Selection.ShapeRange(1) With S A = .Height * .Width End With Debug.Print A End Sub
以下のように出力される。
Sub 四角いシェイプの面積() Dim S As Shape Set S = Selection.ShapeRange(1) A = .Height * .Width Debug.Print A End Sub
ドットの左にスペースまたは丸括弧が来るときは、親オブジェクトを挿入するなどの対処が取れそうだけれど、スペースと丸括弧以外は無いのだろうか。やるならもっと汎用的で確実な方法を採りたい。
そもそも単純変換してしまうと文字列中にあるドットにまで親オブジェクト名を挿入してしまう。
色々考慮する点はありそうだが、ステートメントの判定が複雑になりすぎる。
今は関数でごちゃごちゃやっているところも、別途ステートメントオブジェクトを作りたくなる。
今回とは逆の、With無しのコードをWith化するマクロも作ってみたいが、UnWithより難しそうなので一旦保留中である。
色々考えているうちに面倒くさくなってきたので今日はここまで。