楕円形の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
  1. UserFormをダブルクリックしてUserFormのClickイベントに閉じるコードを記述します

 これは、UserFormを楕円にすると閉じるボタン[×]をクリックできなくなるかもしれないからです

 ちなみに、Ctrl+[F4]キーでもUserFormを閉じることができます

Private Sub UserForm_Click()
    Unload Me
End Sub
  1. 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
  1. VBEで[F5]キーを押すなどしてUserFormを表示します

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

CreateEllipticRgn(10, 10, 250, 150)

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

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