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

By | 2016-02-16

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


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

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

  1. Smithe987

    You really make it seem so easy with your presentation but I find this topic to be really something which I think I would never understand. It seems too complicated and extremely broad for me. I’m looking forward for your next post, I’ll try to get the hang of it!

    Reply
  2. http://obscenevirus4394.snack.ws/

    I leave a comment when I like a article on a website or I have something to valuable to contribute to the discussion. It’s
    caused by the passion communicated in the post I looked at.
    And after this article VBAで.net風のコントロールを使ってみたい |
    cellmasters blog. I was moved enough to write a comment 😉 I actually do have 2 questions
    for you if you usually do not mind. Could it be just me or do some of the remarks appear like left by brain dead people?
    😛 And, if you are writing at other social sites, I’d like to keep up with anything new you have to post.
    Would you list the complete urls of all your social pages
    like your twitter feed, Facebook page or linkedin profile?

    Reply

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です