テキストボックスをクリックしてラベルを移動

質問

現在Excel2000を使用しています。

ユーザーフォームにリストボックスを貼り付け、その中に縦に150個ほどテキストボックスが貼り付けてあります。そのテキストボックスの一番上のひとつだけを囲むようにして、ラベルを設置してあります。（ラベルのCaptionは""、ボーダーカラーは赤色でテキストボックスが選択されてるように見せています。）

　そこで、テキストボックスをクリックしたらそのテキストボックスの高さ(Top）に合わせてラベルが移動するようにしたいのですがどうしたらよろしいでしょうか？

　よろしくお願いします。

回答No.1

end-u · ベストアンサー

TextBoxのEnterイベントを使って処理を記述すれば良いですが、

'UserForm1Module
Option Explicit

Private Sub chkTest(ByVal tmp As String)
　　Me.Label1.Top = Me.Controls(tmp).Top - 1
End Sub
'まず、↑こういう共通プロシージャをつくって
Private Sub TextBox1_Enter()
　　Call chkTest(Me.ActiveControl.Name)
End Sub

Private Sub TextBox2_Enter()
　　Call chkTest(Me.ActiveControl.Name)
End Sub
：
：
というような感じでTextBoxの数だけイベントを書く必要があります。
処理が共通なのでコピーと編集で地道にやればできます。
ワークシート上でオートフィルや関数を利用してコード文字列をつくって
それをコピーすれば手間も省けるかもしれません。

後は、Classモジュールを使ってTextBoxのイベントをまとめる方法もあります。
簡易的には
'UserForm1Module
Option Explicit

Private csTxt(1 To 10) As Class1

Private Sub UserForm_Initialize()
　　Dim i As Long

　　For i = 1 To 10
　　　　Set csTxt(i) = New Class1
　　　　Set csTxt(i).fmTxt = Me.Controls("TextBox" & i)
　　Next
End Sub

Private Sub UserForm_Terminate()
　　Erase csTxt
End Sub

Sub chkTest()
　　Static con As String
　　Dim tmp　　As String

　　tmp = Me.ActiveControl.Name
　　If con <> tmp Then
　　　　Me.Label1.Top = Me.Controls(tmp).Top - 1
　　　　con = tmp
　　End If
End Sub

'Class1Module
Option Explicit

Public WithEvents fmTxt As MSForms.TextBox

Private Sub fmTxt_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, _
　　　　　　　　　　　　ByVal Shift As Integer)
　　Call UserForm1.chkTest
End Sub

Private Sub fmTxt_MouseUp(ByVal Button As Integer, _
　　　　　　　　　　　　　ByVal Shift As Integer, _
　　　　　　　　　　　　　ByVal X As Single, _
　　　　　　　　　　　　　ByVal Y As Single)
　　Call UserForm1.chkTest
End Sub

こんな感じになります。
ちゃんとやろうとすると
http://www.h3.dion.ne.jp/~sakatsu/Bpca_Focus.htm
このページ辺りが参考になると思いますので勉強してください。

お礼

返答ありがとうございます。

Classモジュールを使用する方法でうまくできました。URLも参考にさせて頂いてもっと勉強します！

ありがとうございました。