※こちらは技術的な解説メインとなります、ツールの使い方についてはこの記事をご覧ください
はじめに
Tkinterに限らずコードでGUIを作成するとき、レイアウトの設定が面倒と感じたり、思うようにパーツの配置ができなかったりした経験をした人は多いのではないでしょうか?
その点、Excel VBAのユーザーフォーム作成機能は非常に楽で時間をかけずに理想のレイアウトを作成可能です
「PAGE」というTkinter作成用のGUIツールも使用してみましたが、使い勝手のよさはVBAには及びませんでした
そこで思いついたのが、VBAのユーザーフォームをTkinter用に変換すること
Tkinterに変換が可能なら、他の言語のGUI作成にも応用が効きます
ということで、変換用のプログラムを作成しました、製作期間は1か月ほどです
プログラムはここからダウンロードできるのでぜひ使ってみてください
変換精度はこんな感じです
備忘録として、作成過程で苦戦したところを綴っていきます
どう変換するか
VBAからユーザーフォームのオブジェクト情報を参照するプロパティを使用し、その情報を使用してTkinterのウィジェットに置き換えていきます
例えば
UserForm1.Caption -> ユーザーフォームのタイトル
UserForm1.Name -> ユーザーフォームのオブジェクト名(UserForm1)
Frame1.Parent.Name -> Frame1の親オブジェクトの変数名(ここではUserForm1)
Frame1.Width, Frame1.Height, Frame1.Top, Frame1.Left -> Frame1の位置
TypeName(Frame1) -> Frame1の型"Frame"が取得される
といった感じです
これらの情報を変数に代入して、コードの文字列を生成します
子コントロールの情報はフォームの名前がUserForm1の場合
Dim ctrl As Object
For Each ctrl In UserForm1.Controls
Debug.Print ctrl.Name
Next
これでオブジェクトの一覧を取得できます
後は以下のようにコードの文字列を作成していきます
Const q As String = """"
Dim r As String
r = ""
Dim root As Object
Set root = UserForm1
r = r & "import tkinter as tk" & vbLf
r = r & "from tkinter import ttk" & vbLf
r = r & "from tkinter import font" & vbLf
r = r & root.Name & " = " & "tk.Tk()" & vbLf
r = r & "style = ttk.Style()" & vbLf
r = r & "style.theme_use('default')" & vbLf
r = r & root.Name & ".title(" & q & root.Caption & q & ")" & vbLf
早速変換プログラムを作成し、無事に変換成功・・・
と思ったらある壁にぶつかります
システムカラーについて
Windowsにはシステムカラーというものが存在し、ユーザーフォームのデフォルトカラーにもシステムカラーのうちの1つが割り当てられています
.BackColorや.ForeColorで取得した値をそのまま16進数カラーコードに変換しても色が合わないため調べたところ、システムカラーはそのままでは変換ができないようです
例えばテキストボックスのデフォルト背景色はRGBでは0xFFFFFF(白)ですがBackColorをプロパティで参照すると-2147483643となりこれをHex関数で16進数にすると80000005になり色が一致しません
システムカラーのRGBカラーコードを取得するにはWindows APIのGetSysColorを使います
取得したカラーコードが負の数になる、色が0xFFFFFFの範囲を超えている場合はシステムカラーと思って間違いなさそうです
以下の関数を使用してシステムカラーなら一旦10進数のカラーコードに変換してから16進数に変換、それ以外の場合は直接10進数から16進数カラーコードに変換できるようにしました
#If VBA7 Then
' 64bit版Office/VBA7 以降
Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
#Else
' 32bit版Office
Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
#End If
Private Function FormColorToHex(ByVal clr As Long) As String
Dim r As Long, g As Long, b As Long
' システムカラーの場合一旦10進数の色コードに変換
If 0 > clr Or clr >= 2147483648# Then
clr = GetSysColor(clr And &HFF)
End If
' RGB 各成分を取り出す
r = clr And &HFF ' 下位 8 ビット
g = (clr \ &H100) And &HFF ' 8-15 ビット
b = (clr \ &H10000) And &HFF ' 16-23 ビット
' #RRGGBB 形式に整形して返す
FormColorToHex = "#" & _
Right("0" & Hex(r), 2) & _
Right("0" & Hex(g), 2) & _
Right("0" & Hex(b), 2)
End Function
VBAのユーザーフォームの大きさと位置はピクセル単位ではない
色の取得方法を修正し変換成功、と思ったのもつかの間で、変換前と変換後を比べてみるとレイアウトとウィンドウの大きさがなんか異なります
ChatGPTに確認してみたところ、UserFormでは"Twips"という単位を使用するようです、一方Tkinterではピクセル単位(いわゆる画面のxy座標)で指定します
単位が異なる以上、変換しないといけません
変換用の関数を作っていろいろやってみましたがどうにもうまくいかず・・・
そこでWindows APIを使って実際のユーザーフォームの大きさを取得する方法を試してみました
ユーザーフォームのHWND(ウィンドウハンドル)を取得する方法はVBAでは用意されていないので、ちょっとした小技を使用しました
' UUID4の生成関数GenerateUUIDv4とhwndの取得関数Win32_FindWindowWを別途用意する
' 同名のウィンドウのハンドルを取得しないよう、hwnd取得時にタイトルをユニークな名前に変える
' hwndを取得したらすぐに元の名前に戻す
originalFrmTitle = frm.caption
tempFrmTitle = "TempName_" & GenerateUUIDv4()
frm.caption = tempFrmTitle ' "TempName_1eef7272-86fe-40c0-8aea-ffd1d83ae3ed"のような名前に一時的に変更
hwnd = Win32_FindWindowW("", tempFrmTitle)
frm.caption = originalFrmTitle
名前やクラスで指定した場合、同名のユーザーフォームがあると誤ったものが取得されてしまうかもしれないので、UUIDを使用してランダム生成の被らないファイル名に変更をします
そのファイル名に対してFIndWindowWを使用することで確実にfrmに代入されたオブジェクトのhwndを取得できます
ちなみに理由は不明ですが、ユーザーフォームの代入用変数はObject型で宣言しないと名前の変更が反映されずhwndの取得もできないので失敗します(当初MSForms.UserForm型で宣言してうまくいきませんでした)
Dim r As RECT
Dim pixWidth As Long, pixHeight As Long
Dim scaleX As Double, scaleY As Double
' 実際のクライアント領域を取得
GetClientRect hwnd, r
pixWidth = r.Right - r.Left
pixHeight = r.Bottom - r.Top
' Twips → ピクセル換算係数
scaleX = pixWidth / frm.InsideWidth
scaleY = pixHeight / frm.InsideHeight
取得したhwndに対して、Windows APIのGetClientRectでクライアント領域(タイトルバーを除いた領域)のサイズを取得して、同じくフォームのプロパティでクライアント領域に相当するInsideWidth, InsideHeightを取得
両者を比較することで計算用の係数を取得します
あとは、以下の関数を使用してピクセルサイズを計算します
Private Function UserFormSizeToPixel(ByVal ufSize As Double, ByVal factor As Double) As Long
' ユーザーフォーム、コントロールのサイズをピクセル単位に変換する関数
UserFormSizeToPixel = Round(ufSize * factor)
End Function
' 取得した係数を利用してピクセルサイズを計算
pixelWidth = UserFormSizeToPixel(frm.Width, scaleX)
pixelHeight = UserFormSizeToPixel(frm.Height, scaleY)
これでピクセルサイズを計算して再度生成したコードを実行すると・・・
だいぶ大きさが近づきましたが、高さと幅にわずかにズレがあります
このズレについて検証したところ、ある差分を埋めれば解消できることがわかりました
' GetClientRect, GetWindowRect, RECT構造体を別途宣言
Private Function GetUserFormScaleFactorsAndOffsets(ByVal frm As Object) As Variant()
' ユーザーフォームのサイズをピクセルサイズに変換するための係数と補正用の差分を取得する関数
' Windows APIでウィンドウのサイズをピクセル単位で取得し、ユーザーフォームの設定サイズと比較する方式で取得
Dim clRect As RECT
Dim winRect As RECT
Dim pixClWidth As Long, pixClHeight As Long
Dim pixWinWidth As Long, pixWinHeight As Long
Dim pixWidthOffset As Long, pixHeightOffset As Long
Dim scaleX As Double, scaleY As Double
Dim hwnd As LongPtr
Dim originalFrmTitle As String
Dim tempFrmTitle As String
Dim results(0 To 3) As Variant
' 同名のウィンドウのハンドルを取得しないよう、hwnd取得時にタイトルをユニークな名前に変える
' hwndを取得したらすぐに元の名前に戻す
originalFrmTitle = frm.caption
tempFrmTitle = "TempName_" & GenerateUUIDv4()
frm.caption = tempFrmTitle
hwnd = Win32_FindWindowW("", tempFrmTitle)
frm.caption = originalFrmTitle
If CLng(hwnd) = 0 Then
Err.Raise Number:=513, Description:="Failed to get HWND."
End If
' 実際のクライアント領域のサイズを取得
GetClientRect hwnd, clRect
pixClWidth = clRect.Right - clRect.Left
pixClHeight = clRect.Bottom - clRect.Top
' ウィンドウの実際のサイズとクライアント領域のサイズのX, Yの差分を取得
GetWindowRect hwnd, winRect
pixWinWidth = winRect.Right - winRect.Left
pixWinHeight = winRect.Bottom - winRect.Top
pixWidthOffset = pixWinWidth - pixClWidth
pixHeightOffset = pixWinHeight - pixClHeight
' Twips → ピクセル換算係数
scaleX = pixClWidth / frm.InsideWidth
scaleY = pixClHeight / frm.InsideHeight
' 横縦でほぼ同じなら平均を返す
If Abs(scaleX - scaleY) < 0.01 Then
results(0) = (scaleX + scaleY) / 2
results(1) = (scaleX + scaleY) / 2
Else
' 横縦で差がある場合
results(0) = scaleX
results(1) = scaleY
End If
results(2) = pixWidthOffset
results(3) = pixHeightOffset
GetUserFormScaleFactorsAndOffsets = results
End Function
' rootはユーザーフォームのオブジェクトが代入された変数
' サイズ変換用の係数を取得
sizeFactorsAndOffsets = GetUserFormScaleFactorsAndOffsets(root)
sizeFactorX = sizeFactorsAndOffsets(0)
sizeFactorY = sizeFactorsAndOffsets(1)
' ユーザーフォームのサイズをピクセルサイズに変換
pixelWidth = UserFormSizeToPixel(root.Width, sizeFactorX)
pixelHeight = UserFormSizeToPixel(root.Height, sizeFactorY)
pixelWidth = pixelWidth - sizeFactorsAndOffsets(2)
pixelHeight = pixelHeight - sizeFactorsAndOffsets(3)
上記のようにクライアント領域とウィンドウ全体の差分を後から引けば解決しました
これで画面の拡大率設定が100%の場合は完璧に変換できるようになりましたが、150%にしたりするとやはりうまくいかないのでさらに修正を加えます
以下のコードで画面のdpiを取得し、計算後のピクセルサイズに反映させることで画面の拡大率設定に関係なく正確に変換できるようにします
' Windows APIのGetDeviceCapsを別途宣言する
Private Function GetPrimaryMonitorDPI() As Variant()
Dim hdc As LongPtr
Dim dpiX As Long, dpiY As Long
Dim results(0 To 1) As Variant
Const LOGPIXELSX As Long = 88 ' Horizontal DPI
Const LOGPIXELSY As Long = 90 ' Vertical DPI
' ウィンドウ全体のデバイスコンテキスト(DC)を取得
hdc = GetDC(0)
' 縦と横のDPIを取得
dpiX = GetDeviceCaps(hdc, LOGPIXELSX)
dpiY = GetDeviceCaps(hdc, LOGPIXELSY)
' DCを解放
ReleaseDC 0, hdc
results(0) = dpiX
results(1) = dpiY
' DPIを返す
GetPrimaryMonitorDPI = results
End Function
' scaleFactorX, scaleFactorYはDouble型で宣言
dpis = GetPrimaryMonitorDPI
scaleFactorX = dpis(0) / 96
scaleFactorY = dpis(1) / 96
' モニターの拡大率で割る
pixelWidth = Round(pixelWidth / scaleFactorX)
pixelHeight = Round(pixelHeight / scaleFactorY)
これでウィンドウの大きさについてはほぼ完璧に変換できるようになりました
早速ネットからいろいろなフォームをダウンロードして変換テストを行ってみたところ、別の問題が発生しました
VBAのユーザーフォームの並び順は表示の優先度や親子関係とは無関係
ここでいう並び順とはUserForm.Controlsで取得できる子コントロール一覧の順番のことです
この並び順は単純な設置順により決定されるようです
テストを繰り返したところ、ある問題が発生しました
1.ラベル同士を同じ位置に重ねた場合、VBAでは上にあるラベルがTkinterでは下に表示される場合がある
2.Frameの中にButtonを設置してあるフォームなどで、生成したコード内で子であるButtonが親のFrameより先に設置されてしまう、まだ宣言してないウィジェットを親として設置しようとするため当然エラーになる
Tkinterでは後に設置したものが優先して上に表示される仕様ですが、どうやらVBAではそうではないみたいです
先に設置してもドラッグ&ドロップで再度動かせば上に重ねられる仕様だからです、ただし動かしてもUserForm.Controlsの並び順はそのままのため、違いが発生します
それは仕方ないとして、親子関係のあるウィジェットでエラーを発生させるのは避けたいので、対策をしました
Private Function GetFormControlDepth(ByVal ctrl As Object) As Long
' コントロールの階層を取得する
Dim depth As Long
Dim temp As Variant
depth = 0
Set temp = ctrl
Do While True
If depth Mod 10 = 0 Then DoEvents
On Error GoTo Finally
Set temp = temp.Parent
depth = depth + 1
On Error GoTo 0
Loop
Finally:
If Err.Number <> 438 Then
Err.Raise Number:=Err.Number
End If
GetFormControlDepth = depth
End Function
Private Sub InsertionSortJaggedArray(ByRef arr As Variant)
' ネストされた配列のindex0の要素の数値を基準に昇順で挿入ソートする
' 例: [[1, "A"], [3, "B"], [2, "C"]] -> [[1, "A"], [2, "C"], [3, "B"]]
' 同じ数値同士の並び順には影響を与えない
' 例: [[3, "C"], [3, "A"], [1, "A"], [3, "B"]] -> [[1, "A"], [3, "C"], [3, "A"], [3, "B"]]
Dim minIndex As Long
Dim maxIndex As Long
minIndex = LBound(arr)
maxIndex = UBound(arr)
Dim i As Long, j As Long
Dim swap As Variant
For i = minIndex + 1 To maxIndex
swap = arr(i)
For j = i - 1 To minIndex Step -1
If arr(j)(0) > swap(0) Then
arr(j + 1) = arr(j)
Else
Exit For
End If
Next
arr(j + 1) = swap
Next
End Sub
エラーが出るまで親を参照→そのさらに親を参照を繰り返し、参照できた回数を階層として取得するという単純な仕組みの関数を用意
UserFormなら0, その直下のFrameなら1, さらにFrameの子なら2 というように階層を取得します
そしてそれをソートするための関数も用意します
[[階層, コントロールオブジェクト], [階層, コントロールオブジェクト]・・・]のようにネストした配列を作成し、それを階層の浅い順にソート後再度単一の配列かコレクションに戻すイメージです
ソートアルゴリズムは挿入ソートを使って同じ階層の場合元の順番を保持します、クイックソートやバブルソートだと同じ階層同士だと順番がバラバラになってしまうので注意が必要です
これで並び変えたらエラーが出なくなりました！
GitHub上のプログラムはVBAの文字化け対策でコメントも全文英語になっていますが、このページで日本語コメントのものを見れますのでフォークすることがあれば役に立ててください