rsinz’s diary

趣味コードや日記のブログです。文章をうまく書けるようになりたい。

Excel VBAでモダンなForm(枠無しForm)

個人で使っているWindows10に慣れると、どうも会社でのWindows7のAeroにレガシー感を感じてしまいます。
今日は、VBAでWin10風(メトロスタイル?フラットスタイル?)のFormを作ってみようと思います。
最後にダウンロードURLを貼りますので、読むのが面倒な人はスクロールしてください。

0.準備

まずは、モジュールの準備です。Excelを開いて、Alt+F11でエディタを開きます。VBAProjectを選択した状態で、右クリックから挿入→ユーザーフォームとクラスモジュールを追加。

f:id:rsinz:20161230132245p:plain

名前をプロパティから、それぞれ「MainForm」「clsUserForm」に変更しておきます。

f:id:rsinz:20161230132348p:plain

1.枠無しFormをつくる

WinAPIを宣言します。以下のコードをクラスモジュールに記載します。

clsUserForm

Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc.dll" (ByVal IAcessible As Object, ByRef hWnd As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Const GWL_STYLE = (-16&)
Const GWL_EXSTYLE = (-20&)
Const WS_CAPTION = &HC00000
Const WS_EX_DLGMODALFRAME = &H1&

実際の仕事をするファンクションもクラスに書いておきましょう。

Function NonTitleBar(objName As String) As Long

  Dim wnd As Long, formHeight As Double
  Dim uForm As Object

  For Each uf In VBA.UserForms
    If uf.Name = objName Then Set uForm = uf: Exit For
  Next

  formHeight = uForm.InsideHeight
  WindowFromAccessibleObject uForm, wnd

  SetWindowLong wnd, GWL_EXSTYLE, GetWindowLong(wnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
  NonTitleBar = SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) And Not WS_CAPTION)

  DrawMenuBar wnd
  uForm.Height = uForm.Height - uForm.InsideHeight + formHeight
End Function

NonTitleBarは失敗すると0を返してきます。
続いてForm側です。

閉じる用のボタンを配置して、名前を「btnClose」にしておきます。
ボタンをダブルクリックして、フォームを閉じる処理を書きます。

f:id:rsinz:20161230132533p:plain

MainForm

Private Sub btnClose_Click()
  Unload Me
End Sub

UserFormのInitialize処理をコンボボックスから追加します。

f:id:rsinz:20161230132720p:plain

Initializeに先ほど作ったクラスを呼び出します。

Private clsForm As New clsUserForm1

Private Sub UserForm_Initialize()
  clsForm.NonTitleBar Me.Name
End Sub

F5で実行すると、画面中央に枠無しフォームが表示されると思います。

f:id:rsinz:20161230132845p:plain

2.ドラッグできるようにする

さらに、Formをドラッグで動かせるようにします。以下のコードをクラスに追加します。

clsUserForm

' 最上部に宣言
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe Sub ReleaseCapture Lib "user32.dll" ()
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Sub FormDrag(objName As String, ByVal Button As Integer)

  Dim hWnd As Long
  Dim uForm As Object

  For Each uf In VBA.UserForms
    If uf.Name = objName Then Set uForm = uf: Exit For
  Next

  If Button = 1 Then
    WindowFromAccessibleObject uForm, hWnd
    ReleaseCapture
    Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  End If

End Sub

Form側ではフォーム上でマウスダウンしたときに、FormDragを呼び出します。

MainForm

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  clsForm.FormDrag Me.Name, Button
End Sub

F5で実行して・・・どうでしょう。Formを掴めましたでしょうか?

3.おわりに

今回は「まず見た目から入りたい!」という人向けに書きました。これを機にVBA&WinAPIを学んでみたいという方が増えてくれることを願います。

最後に、自分が作ったテンプレートフォームのダウンロード用のURLを貼っておきます。
https://github.com/rsinz/vba/releases

こんな感じです。

f:id:rsinz:20161230132938p:plain