Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


8574 / 13644 ツリー ←次へ | 前へ→

【32499】アクティブになっているオブジェクトを調べる方法ってありますか? cook 05/12/16(金) 9:06 質問[未読]
【32503】Re:アクティブになっているオブジェクトを... COLA 05/12/16(金) 10:59 回答[未読]
【32504】Re:アクティブになっているオブジェクトを... COLA 05/12/16(金) 11:21 発言[未読]
【32508】Re:アクティブになっているオブジェクトを... ichinose 05/12/16(金) 14:38 発言[未読]
【32514】Re:アクティブになっているオブジェクトを... ichinose 05/12/16(金) 16:31 発言[未読]

【32499】アクティブになっているオブジェクトを調...
質問  cook  - 05/12/16(金) 9:06 -

引用なし
パスワード
   複数のComboboxを用意した場合、アクティブになっているComboboxのオブジェクトだけを調べる方法ってあるのでしょうか?
以下のようにそれぞれフラグを立ててもいいのですが、この方法だとComboboxの数が増えれば増えるほど、ソースが醜くなってしまいます。

Private Sub ComboBox1_Change()
  active1 = true
End Sub

Private Sub ComboBox2_Change()
  active2 = true
End Sub

Private Sub ComboBox3_Change()
  active3 = true
End Sub

【32503】Re:アクティブになっているオブジェクト...
回答  COLA  - 05/12/16(金) 10:59 -

引用なし
パスワード
   先日、他サイトで教えていただいたコードです。

'標準モジュール
Function ApplicationCaller()
ApplicationCaller = UserForm1.ActiveControl.Name
End Function

Sub cp()
MsgBox UserForm1.Controls(ApplicationCaller).Name
End Sub

'ユーザーフォーム
Private Sub ComboBox1_Change()
Call cp
End Sub

Private Sub ComboBox2_Change()
Call cp\
End Sub

【32504】Re:アクティブになっているオブジェクト...
発言  COLA  - 05/12/16(金) 11:21 -

引用なし
パスワード
   間違いがありました。
"¥"が余計でした。
失礼しました。

Private Sub ComboBox2_Change()
Call cp
End Sub

【32508】Re:アクティブになっているオブジェクト...
発言  ichinose  - 05/12/16(金) 14:38 -

引用なし
パスワード
   こんにちは。

>複数のComboboxを用意した場合、アクティブになっているComboboxのオブジェクトだけを調べる方法ってあるのでしょうか?
>以下のようにそれぞれフラグを立ててもいいのですが、この方法だとComboboxの数が増えれば増えるほど、ソースが醜くなってしまいます。

クラスモジュールを使用すると可能ですが、コンボボックスの数によって
従来どおりの記述のほうが簡単かもしれませんよ(10個ぐらいなら考えてもよいかも)

まず、クラスモジュールから

Class1のクラスモジュールに

'================================================
Event cchange(combo As Object)
Private cmb As Class2
Private c_controls As Collection
'================================================
Private Sub Class_Initialize()
  Set c_controls = New Collection
End Sub
'================================================
Private Sub Class_Terminate()
  Set c_controls = Nothing
End Sub
'================================================
Sub cmd_change(combo As Object)
  RaiseEvent cchange(combo)
End Sub
'================================================
Sub add(obj1 As Object)
  Set cmb = New Class2
  cmb.set_controls obj1, Me
  c_controls.add cmb
End Sub


Class2のクラスモジュールに
'================================================
Private WithEvents cmd As MSForms.ComboBox
Private pa_obj As Object
'================================================
Private Sub cmd_change()
  pa_obj.cmd_change cmd
End Sub
'================================================
Sub set_controls(obj1 As Object, obj2 As Object)
  Set cmd = obj1
  Set pa_obj = obj2
End Sub


で問題のUserform1には、複数のコンボボックスと
ラベル(Label1)は最低貼り付けておいてください。

そのユーザーフォームのモジュールに

'================================================

Private WithEvents class_cmb As Class1
'================================================
Private Sub class_cmb_cchange(combo As Object)
’このイベントプロシジャーに一括してコードが書けます

  Label1.Caption = "今、" & combo.Name & " を変更したよ"
End Sub
'================================================
Private Sub CommandButton1_Click()
  Dim aaa As Object
  Set aaa = ComboBox1
  MsgBox TypeName(aaa)
End Sub
'================================================
Private Sub UserForm_Initialize()
  Dim cont As Object
  Set class_cmb = New Class1
  With class_cmb
    For Each cont In Controls
     If UCase(TypeName(cont)) = UCase("combobox") Then
       With cont
         .List() = Array("a", "b", "c")
         .ListIndex = 0
         End With
       .add cont
       End If
     Next
    End With
End Sub
'================================================
Private Sub UserForm_Terminate()
  Set class_cmb = Nothing
End Sub


最後に
標準モジュールに
'===============================================
sub main()
  userform1.show
end sub

として、mainを実行して見てください。

クラスで作成しても結構コードが長くなりますが、
クラスモジュールは使い回しが出来るので
場合によっては便利かもしれませんよ!!

試してみてください。

【32514】Re:アクティブになっているオブジェクト...
発言  ichinose  - 05/12/16(金) 16:31 -

引用なし
パスワード
   >まず、クラスモジュールから
>
>Class1のクラスモジュールに
>
>'================================================
>Event cchange(combo As Object)
>Private cmb As Class2
>Private c_controls As Collection
>'================================================
>Private Sub Class_Initialize()
>  Set c_controls = New Collection
>End Sub
>'================================================
>Private Sub Class_Terminate()
>  Set c_controls = Nothing
>End Sub
>'================================================
>Sub cmd_change(combo As Object)
>  RaiseEvent cchange(combo)
>End Sub
>'================================================
>Sub add(obj1 As Object)
>  Set cmb = New Class2
>  cmb.set_controls obj1, Me
>  c_controls.add cmb
>End Sub
>
>
>Class2のクラスモジュールに
>'================================================
>Private WithEvents cmd As MSForms.ComboBox
>Private pa_obj As Object
>'================================================
>Private Sub cmd_change()
>  pa_obj.cmd_change cmd
>End Sub
>'================================================
>Sub set_controls(obj1 As Object, obj2 As Object)
>  Set cmd = obj1
>  Set pa_obj = obj2
>End Sub
>
>
>で問題のUserform1には、複数のコンボボックスと
>ラベル(Label1)は最低貼り付けておいてください。
>
>そのユーザーフォームのモジュールに
>
>'================================================
>
>Private WithEvents class_cmb As Class1
>'================================================
>Private Sub class_cmb_cchange(combo As Object)
>’このイベントプロシジャーに一括してコードが書けます
>
>  Label1.Caption = "今、" & combo.Name & " を変更したよ"
>End Sub
>'================================================


'*************************************
>Private Sub CommandButton1_Click()
>  Dim aaa As Object
>  Set aaa = ComboBox1
>  MsgBox TypeName(aaa)
>End Sub
'↑これ削除してください
'***************************************
>'================================================
>Private Sub UserForm_Initialize()
>  Dim cont As Object
>  Set class_cmb = New Class1
>  With class_cmb
>    For Each cont In Controls
>     If UCase(TypeName(cont)) = UCase("combobox") Then
>       With cont
>         .List() = Array("a", "b", "c")
>         .ListIndex = 0
>         End With
>       .add cont
>       End If
>     Next
>    End With
>End Sub
>'================================================
>Private Sub UserForm_Terminate()
>  Set class_cmb = Nothing
>End Sub
>
>
>最後に
>標準モジュールに
>'===============================================
>sub main()
>  userform1.show
>end sub

尚、Excel2000以上にで動作可能です。

8574 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free