Office TANAKA - Excel VBA Tips[楕円形のUserFormを作る]

個人的にはあまり必要性を感じませんが、まぁこんなこともできるという例として。ちなみにVBA的には珍しい使い方ですが、VBやC++などのプログラミング言語では割とよく知られたテクニックです。

UserFormを楕円にするには、APIのSetWindowRgnとCreateEllipticRgnを使います。また、SetWindowRgnには楕円にするフォームのウィンドウハンドルを指定しなければなりませんので、FindWindowAも使います。

【操作手順】
1.UserFormを挿入します
2.標準モジュールを挿入します
3.標準モジュールに次の宣言を記述します

Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, _
                                            ByVal hRgn As Long, _
                                            ByVal bRedraw As Boolean) As Long

Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, _
                                                ByVal Y1 As Long, _
                                                ByVal X2 As Long, _
                                                ByVal Y2 As Long) As Long

Declare Function FindWindowA Lib "user32" (ByVal clpClassName As String, _
                                           ByVal lpWindowName As String) As Long

4.UserFormをダブルクリックしてUserFormのClickイベントに閉じるコードを記述します
　これは、UserFormを楕円にすると閉じるボタン[×]をクリックできなくなるかもしれないからです
　ちなみに、Ctrl+[F4]キーでもUserFormを閉じることができます

Private Sub UserForm_Click()
    Unload Me
End Sub

5.UserFormのInitializeイベントに次のコードを記述します

Private Sub UserForm_Initialize()
    Dim OvalSet As Long, rc As Long, hwnd As Long
    hwnd = FindWindowA("ThunderDFrame", Me.Caption)
    OvalSet = CreateEllipticRgn(10, 10, 250, 150)
    rc = SetWindowRgn(hwnd, OvalSet, True)
End Sub

6.VBEで[F5]キーを押すなどしてUserFormを表示します

楕円の大きさや切り出す位置を決めているのが

CreateEllipticRgn(10, 10, 250, 150)

です。CreateEllipticRgnにはCreateEllipticRgn(X1, Y1, X2, Y2)のように指定します。それぞれの引数は次の位置を表します。

UserFormのタイトルバーが見えていれば、そこをドラッグしてUserFormを移動することもできます。