Monthly Archives: 2月 2016

VBAで.net風のコントロールを使ってみたい

cellmasters.netのColoです。最近は情報過多の社会ですので大抵の事がWEBで検索すれば、なんらかの答えに辿り着く事ができます。そして多くの人が求めている答えに関しては、既に多くの回答が見つかるでしょう。どれが正解という事はありませんが、アプリケーションの使い方を熟知した人が書いたコードはやはりシンプルでスマートなものです。そんな検索結果に出会いたいものですね。

さて.netで開発をしているとリッチで手軽なコントロールに目が慣れてきます。WEBサイトですら最近は昔と比べると華やかですよね。私はVBA大好きですので大抵の事はVBAからのアプローチを試みるのが好きなのですが、同じ事をやっているはずなのに洗練された見た目の.netだとなんとなく凄く見えてしまうものです。たとえばUserformで利用するコマンドボタンのデザインや機能です。VBAのコマンドボタンは昔ながらのデザインで、マウスオーバーしてもなんら反応もしてくれません。ちょっと寂しいですね。

001

とはいえエクセルのVBAから.NET Frameworkのパーツを使う事はできません。一部の機能は使えますがかなり限定的です(今回はここでは触れませんが)。では.netでコードを書いてUIを作成し、そこからエクセルをコントロールすればいいじゃないか?という意見もあるかと思いますが、今回の趣旨はエクセルのVBAで.net風のボタンを使う、つまりパーツを「デザイン」し創意工夫で乗り切ろう!というのが主題になります。

おそらくVBAをお使いの多くの方がお察しの通り、今回の目的の実現にはLabelコントロールのPictureプロパティを利用します。そしてVBAではあまりぱっとした使い道が思いつかないクラスモジュールを使って、お手軽でスタイリッシュな「コマンドボタン風ラベル」を作ってみることにします。

それでは準備に入りましょう。

まず準備するものは、フォームを挿入しUserForm1という名前になっていることを確認してください。その上に3つのLabelコントロールを置いてから次の3つのボタンイメージをPictureプロパティから読み込んでおきましょう。(1)デフォルト、(2)MouseOver(マウスが上に乗っかったとき)、(3)MouseDown(マウスのボタンが押されたとき)終わりましたらそれぞれの(オブジェクト名)をlb_btn01、lb_btn02、lb_btn03と変更し、LabelのVisibleプロパティをFalseにしておきます。これで実行時にはこれらのLabelは表示されません。ユーザーフォームの邪魔にならないところにでも置いておいてください。

次にコマンドボタン代わりに使いたいラベルを追加します。追加後(オブジェクト名)をbtnから始まるものに変更しておきます。あとは下記のUserForm1のコードを貼り付けます。フォームの準備はこれで完了です。

次にクラスモジュールを挿入します。(オブジェクト名)をLabelButtonClassとしてください。
ここにはLabelButtonClass以下のコードを貼り付けてください。


《材料》 ※[ブラケット]内はオブジェクト名

  • クラスモジュール [LabelButtonClass] – 1個
  • フォーム [UserForm1] – 1個
  • ボタンのデザイン画像 – 3個 (JPEGやGIFなど)
  • Labelコントロール – 3個
    オブジェクト名は下記の様に変更します。
    Label [lb_btn01]・・・デフォルトのデザインをPictureプロパティで設定
    Label [lb_btn02]・・・MouseOverのデザインをPictureプロパティで設定
    Label [lb_btn03]・・・MouseDownのデザインをPictureプロパティで設定

《コード》

'===============================================
'Form Module : UserForm1
'Labelコントロールをボタンのように利用するクラス
'===============================================

Option Explicit

'Classのメソッドを使う為のダミー
Dim myControl As New LabelButtonClass

Private Sub UserForm_Initialize()
'Labelボタンをクラス(LabelButtonClass)に登録
    myControl.SetLabelButtons Me
End Sub

Private Sub UserForm_Terminate()
'登録したもののあと始末
    Set myControl = Nothing
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'LabelボタンのPictureプロパティ初期化
    myControl.Initialize
End Sub

Private Sub btn_01_Click()
    MsgBox "Clicked"    'クリック時のコード
End Sub

Private Sub btn_02_Click()
    MsgBox "Clicked"    'クリック時のコード
End Sub

Private Sub btn_03_Click()
    MsgBox "Clicked"    'クリック時のコード
End Sub

Private Sub btn_04_Click()
    MsgBox "Clicked"    'クリック時のコード
End Sub

'===============================================
'Class Module : LabelButtonClass
'Labelコントロールをボタンのように利用するクラス
'===============================================

Option Explicit

'イベントドリブンを拾えるように、WithEventsで宣言
Private WithEvents LabelButton As MSForms.Label
Private LabelBtns As New Collection
Dim ActiveForm As Object
Dim LabelControls() As New LabelButtonClass

Public Sub SetMyButton(NewButton As MSForms.Label)
'ユーザーフォーム起動時のLabelボタン登録用
    Set LabelButton = NewButton
    Set ActiveForm = LabelButton.Parent
End Sub

Private Sub LabelButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'共通MouseUpイベント
    LoadPicture 1, LabelButton
End Sub

Private Sub LabelButton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'共通MouseMoveイベント
   LoadPicture 2, LabelButton
End Sub

Private Sub LabelButton_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'共通MouseDownイベント
    LoadPicture 3, LabelButton
End Sub

Private Sub LoadPicture(ByVal Mouse_Event As Integer, ByVal LabelCaller As MSForms.Label)
'共通Pictureプロパティ変更
    Initialize
    LabelCaller.Picture = ActiveForm.Controls("lb_btn0" & Mouse_Event).Picture
    LabelCaller.Tag = 1
End Sub

Public Sub Initialize()
'    LabelボタンのPictureプロパティ初期化
'コレクションをループ
    Dim btn As MSForms.Label
    For Each btn In LabelBtns
        If btn.Tag = 1 Then
            btn.Picture = ActiveForm.lb_btn01.Picture
            btn.Tag = 0
        End If
    Next
End Sub

Public Sub SetLabelButtons(TargetForm As Object)
'Labelボタンをクラス(LabelButtonClass)に登録
    Dim btn As Control, i As Integer
    Set ActiveForm = TargetForm
    For Each btn In ActiveForm.Controls
        If TypeName(btn) = "Label" Then
            If btn.Name Like "btn*" Then
                ReDim Preserve LabelControls(i)
                LabelControls(i).SetMyButton btn
                'Labelボタンのリストをコレクションとして追加
                LabelBtns.Add btn
                i = i + 1
            End If
        End If
    Next
End Sub


サンプルブックのダウンロードはこちら