ビルドンブング

自由でシンプルな生活を求めて試行錯誤する記録を毎日更新中

トップ > プログラミング > 【VBA】ラベルを「押せるボタン」のように見せかける

【VBA】ラベルを「押せるボタン」のように見せかける

プログラミング

当ブログではアフィリエイト広告を利用しています

VBAでユーザ―フォームを、それも見た目をすこしスタイリッシュにしようとフォントを「Meiryo UI」なんかにしていると、困った事態が発生する。
CommandButtonの余白が大きすぎるのである。
テキストボックスの横に検索ボタンをして設置しようとしても、高さを合わせると文字が途切れてしまう。

ということで悩んで、Labelをボタンの代わりにする方法にたどり着いた人もいるはずである。
と思って調べてみたけれど、それほどいないのかもしれない。
 
確かに、ラベルなら文字にフィットした最小限のサイズにできる。
「SpecialEffect」を1にすれば、見た目もボタンと同じにできる。

のだけれど……
あくまでも見た目を同じにしただけで、ボタンと違って押した際のエフェクトが発生しない。
ボタンならこのように、クリックすると凹んだエフェクトになるので、ユーザーが視覚的に押していることを判断できる。

押しミスの防止にも多少は役立つだろう。
ラベルだとそれがないので、処理が目に見えるものでなければ、本当に実行されたのか分かりにくい。
 
それでもラベルの方がスリムなのでボタン代わりに使っていたのだが、ふいに「MouseUp」「MouseDown」のイベントで見た目を変えれば押した際のエフェクトも再現できるのでは、と思った。
 
ボタンの見た目にするのは「SpecialEffect = 1」だけれど「SpecialEffect = 2」にすれば、今度はボタンを押した際の見た目にできる。

というわけで、それぞれのイベントでSpecialEffectを変えるようにする。

 

Private Sub BtnLblSetting_Click()
	'クリック時の処理はClickイベントに書けばOK
End Sub

Private Sub BtnLblSetting_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	BtnLblSetting.SpecialEffect = 2
End Sub

Private Sub BtnLblSetting_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	BtnLblSetting.SpecialEffect = 1
End Sub
「これだとマウスを押したままカーソルをラベル以外の場所に移動させてマウスを離すと押された見た目のままなのでは？」と思うだろうか？
私もそう思っていたのだけれど、MouseUpイベントは別にマウスカーソルがそのコントロール上になくても発生するようだ。
おそらくドラッグ＆ドロップ的な意味合いで、MouseDownイベントが発生した時点で、次のMouseUpイベントはいかなる場所でもそのコントロールに発生する。
てきとうなコントロールにMouseUpイベントを設定して、他のコントロール上でMouseDown、そのコントロール上でMouseUpしてみれば、イベントが発生しないことを確認できるだろう。
 
さて、これでラベルをボタンのように扱えるようにはなったのだけれど、もしもフォーム上にいくつもラベルボタンを設置するとなると、逐一MouseDown、MouseUpイベントを設定するのは面倒である。
クラス化してしまおう。

 

Private WithEvents ButtonLabel As MSForms.Label

Sub ButtonLabel_Initialize(lbl As MSForms.Label)
	Set ButtonLabel = lbl
End Sub

Private Sub ButtonLabel_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	ButtonLabel.SpecialEffect = 2
End Sub

Private Sub ButtonLabel_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
	ButtonLabel.SpecialEffect = 1
End Sub
こんな感じのクラスを作成したら、ボタンラベルを設定したいフォームのInitializeイベントで各ボタンラベルにまとめて設定してやる。

 

Private btnlbl() As New ClsForm

Private Sub BtnLblSetting_Click()
	'クリック時の処理はClickイベントに書けばOK
End Sub

Private Sub UserForm_Initialize()
	Dim iArr As Long
	iArr = -1
	Dim ctrl As Control
	For Each ctrl In Me.Controls
		If InStr(ctrl.Name, "BtnLbl") = 1 Then
			iArr = iArr + 1
			ReDim Preserve btnlbl(iArr)
			btnlbl(iArr).ButtonLabel_Initialize ctrl
		End If
	Next
End Sub
この場合、ボタンラベルに設定したいコントロールの名前は必ず頭に「BtnLbl」とつけるようにしているから、これですべて設定できる。
 
というわけで、見た目にこだわるVBAユーザーはラベルをボタンにしてみては？