| |
▼ponpon さん、かみちゃん さん、おはようございます。
>>ラベルとテキストボックスは対応しているのでしょうか？
>>ラベルをクリックするというのがよくわからないのですが、テキストボックスをクリックしたら、それに対応するラベルのキャプションを反映させるのではいけないのでしょうか？
>
> 対応しておりません。
>
>説明が悪くて申し訳ありません。
>年間の時間割を作っています。現在の仕様は、ラベルは、国、算、社、理・・・・・となっており、クリックすると、captionがコピーされ、テキストボックスは縦に６こ（１時間目から６時間目）横に５こ（月から金まで）の任意の位置に貼り付けられるようになっています。それをセルに反映し、一年間分の時間割が作成されるようになっています。
> したがって、同じようなコードをラベルについて１４こ、テキストボックスについて６０個書いています。（２週間分の時間割を作るので）
> これを配列を使って簡単にできないものかと考えています。
> よろしくお願いします。
ちょっとコントロールの数が多いので、少ない数のコントロールで例題コードを
記述します。
ユーザーフォーム（Userform1）には、
ラベルコントロールが3つ（Label1〜Label3）
テキストボックスが3つ（Textbox1〜Textbox3）
を貼り付けてください（オブジェクト名が、結構重要）
コードの仕様は、
・フォームのラベルをクリックすると、
クリックされたラベルの文字（Caption）が赤くなります。
・この状態でいずれかのテキストボックスをクリックすると
赤色のラベル文字の内容が当該テキストボックスに表示されます。
では、コードです。
クラスモジュールを3つ用意して下さい（「挿入」---「クラスモジュール」）。
クラス名は、Class1、Class2、Class3、つまり、作成されたままの名前を
使います。
まずは、それぞれのクラスモジュールのコード
'Class1
'============================================================
Private evlbl() As Class2
Private l_id As Long
Private lbcnt As Long
Private evtxt() As Class3
Private t_id As Long
Private txtcnt As Long
Public Event lblclick(ByVal lbl As MSForms.Label)
Public Event txtclick(ByVal txt As MSForms.TextBox)
'============================================================
Sub init_lbl(lbl_count)
ReDim evlbl(1 To lbl_count)
For idx = 1 To lbl_count
Set evlbl(idx) = New Class2
Next
lbcnt = lbl_count
End Sub
'==============================================================
Sub set_lbl(id As Long, lbl As MSForms.Label)
With evlbl(id)
Set .lbl = lbl
.lbl_id = id
Set .parentobj = Me
.callbackproc = "evlbl_Click"
End With
End Sub
'==============================================================
Public Sub evlbl_Click(id As Long)
RaiseEvent lblclick(evlbl(id).lbl)
End Sub
'===============================================================
Sub init_txt(txt_count)
ReDim evtxt(1 To txt_count)
For idx = 1 To txt_count
Set evtxt(idx) = New Class3
Next
txtcnt = txt_count
End Sub
'================================================================
Sub set_txt(id As Long, txt As MSForms.TextBox)
With evtxt(id)
Set .txt = txt
.txt_id = id
Set .parentobj = Me
.callbackproc = "evtxt_Click"
End With
End Sub
'===============================================================
Public Sub evtxt_Click(id As Long)
RaiseEvent txtclick(evtxt(id).txt)
End Sub
'Class2
'==================================================================
Public WithEvents lbl As MSForms.Label
Public lbl_id As Long
Public parentobj As Object
Public callbackproc As String
Private Sub lbl_Click()
wk = CallByName(parentobj, callbackproc, VbMethod, lbl_id)
End Sub
'Class3
'=================================================================
Public WithEvents txt As MSForms.TextBox
Public txt_id As Long
Public parentobj As Object
Public callbackproc As String
Private Sub txt_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
wk = CallByName(parentobj, callbackproc, VbMethod, txt_id)
End Sub
'Userform1のモジュールに
'=================================================================
Private cpy_lbl As MSForms.Label
Private WithEvents cls As Class1
'=================================================================
Private Sub cls_lblclick(ByVal lbl As MSForms.Label)
If Not cpy_lbl Is Nothing Then
cpy_lbl.ForeColor = &H0
End If
lbl.ForeColor = &HFF
Set cpy_lbl = lbl
End Sub
'=================================================================
Private Sub cls_txtclick(ByVal txt As MSForms.TextBox)
txt.Text = cpy_lbl.Caption
End Sub
'=================================================================
Private Sub UserForm_Initialize()
Dim idx As Long
Set cls = New Class1
With cls
.init_lbl 3 'ラベルの数
For idx = 1 To 3 '←らヘルの数だけループ
.set_lbl idx, Controls("label" & idx)
Next
.init_txt 3 'テキストボックスの数
For idx = 1 To 3 'テキストボックスの数だけループ
.set_txt idx, Controls("textbox" & idx)
Next
End With
Set cpy_lbl = Nothing
End Sub
以上です。確認して下さい。
クラスや配列については、ここの常連さんの角田さん「目安箱」で
説明されていますから、参考にして下さい。
私もまだ、途中までしか読んでないけど、分かりやすいですよ！！
それに上記のコードの仕様をもっと簡単に実現できるかも・・・。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=51;id=FAQ
↑から入って追ってみてください。
|
|
ichinose
- 04/9/19(日) 10:40 -
