Excel VBA質問箱 IV

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

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


20803 / 76736 ←次へ | 前へ→

【61345】Re:【61303】の追記1
回答  Hirofumi  - 09/4/28(火) 16:43 -

引用なし
パスワード
   紹介した過去ログをキチント見て居ないのですね?
紹介した過去ログのコード全てが必要のなのですよ
ただし、その中の「Private Sub CommandButton1_Click()」のコードを
変更すれば使えるのではと言う事なんですがね

訳が解らなくなるといけないので、全文をUpします(少し修正も更け埋めて)
新しいBookで試して下さい

1、先ず、UserFormをプロジェクトに追加して下さい
2、そのUserFormに以下のコントロールを追加して下さい
 a、CommandButton1を配置します
 b、フレームFrame1を配置:Captionプロパティを「質問1」とします
  Frame1の中に、OptionButton1〜3(特にOptionButton1〜3の必要は有りません)を配置します
  各OptionButtonのCaptionプロパティにOptionButtonをClickした時に得たい値を設定します
 c、フレームFrame2を配置:Captionプロパティを「質問2」とします
  Frame2の中に、OptionButton4〜6(特にOptionButton4〜6の必要は有りません)を配置します
  各OptionButtonのCaptionプロパティにOptionButtonをClickした時に得たい値を設定します
 d、フレームFrame3を配置:Captionプロパティを「質問3」とします
  Frame3の中に、OptionButton7〜9(特にOptionButton7〜9の必要は有りません)を配置します
  各OptionButtonのCaptionプロパティにOptionButtonをClickした時に得たい値を設定します
 e、CommandButton2を配置します
3、次に、UserFormのコードモジュールに以下のコードを其のまま記述します

Option Explicit

'Groupの値取得クラスの配列
Private clsGroup() As Class1
'フレームの数を格納
Private lngFrCount As Long

Private Sub UserForm_Initialize()
 
  Dim i As Long
  Dim j As Long
 
  For i = 0 To Controls.Count - 1
    '全てのOptionButtonにClassを設定
    If TypeName(Controls(i)) _
        = "OptionButton" Then
      j = j + 1
      ReDim Preserve clsGroup(1 To j)
      Set clsGroup(j) = New Class1
      clsGroup(j).Button = Controls(i)
    End If
    'フレームの数をカウント
    If TypeName(Controls(i)) = "Frame" Then
      lngFrCount = lngFrCount + 1
    End If
  Next i

End Sub

Private Sub UserForm_Terminate()

  Dim i As Long
 
  'Classを破棄
  For i = 1 To UBound(clsGroup)
    Set clsGroup(i) = Nothing
  Next i
 
End Sub

Private Sub CommandButton1_Click()

  Dim i As Long
  Dim strResult As String
  
  'Frame1〜3に就いて繰り返し
  For i = 1 To lngFrCount
    '出力用変数が""で無いなら
    If strResult <> "" Then
      'vbCrLf(改行コード)を追加
      strResult = strResult & vbCrLf
    End If
    With Me.Controls("Frame" & i)
      '出力用変数にFrameのCaptionと改行コードと" = "を追加
      strResult = strResult & .Caption & vbCrLf & " = "
      'OptionButtonが選択されている場合
      If .Tag <> "" Then
        '出力用変数に選択値を追加
        strResult = strResult & .Tag
      Else
        '出力用変数に"★★未選択★★"を追加
        strResult = strResult & "★★未選択★★"
      End If
    End With
  Next i
  
  '出力用変数をTextBox1に出力
  TextBox1.Text = strResult
  
End Sub

4、次に、VBEのメニューから「挿入」→「クラスモジュール」を選択して
 プロジェクトにClassモジュールを追加します
 ※初めてClassモジュールを追加した場合、
  ディフォルトのオブジェクト名は「Class1」に成っています
  今回はこのオブジェクト名「Class1」を使用しています
  この名前が違う場合、UserFormのコードの以下の★印の「Class1」を修正して下さい

'Groupの値取得クラスの配列
Private clsGroup() As Class1 ★

  For i = 0 To Controls.Count - 1
    '全てのOptionButtonにClassを設定
    If TypeName(Controls(i)) _
        = "OptionButton" Then
      j = j + 1
      ReDim Preserve clsGroup(1 To j)
      Set clsGroup(j) = New Class1  ★
      clsGroup(j).Button = Controls(i)

5、次に、Class1のコードモジュールに以下をそのまま記述します

Option Explicit

Private WithEvents optButton As MSForms.OptionButton

Public Property Let Button(ByVal optNewValue As MSForms.OptionButton)

  Set optButton = optNewValue
 
End Property

Private Sub Class_Terminate()

  Set optButton = Nothing
 
End Sub

Private Sub optButton_Click()

  'OptionButtonがClickされた場合、
  'OptionButtonのCaptionをフレームのTagに代入
  With optButton
    .Parent.Tag = .Caption
  End With
 
End Sub

6、以上が終わったら、コンパイルして保存して下さい

尚、此のコードを使用した場合質問の回答の増減、新しい質問の追加が簡単にできます
1、回答(OptionButton)を増やしたい場合
 例えば、質問1に4番目のOptionButtonを増やすとすると
 a、Frame1にOptionButtonを追加し
 (この場合OptionButtonのオブジェクト名は構いません、OptionButton11でも可)
 b、OptionButtonのCaptionプロパティを得たい値にする
2、回答(OptionButton)を減らしたい場合
 例えば、質問2の2番目のOptionButtonを減らしたい場合
 a、Frame2のOptionButton5を削除
3、新規の質問を作りたい場合
 例えば、質問4を作りたい場合
 a、UserFormにFrame4を追加(この場合、Frameのオブジェクト名は抜けの無い連番にして下さい)
 b、Frame4OptionButtonを配置(OptionButtonのオブジェクト名は、構いません)
以上で、UserFormのコードは全く弄らないで済みます
0 hits

【61314】【61303】の追記1 超初心者 09/4/25(土) 0:50 質問
【61315】Re:【61303】の追記1 Hirofumi 09/4/25(土) 5:04 発言
【61342】Re:【61303】の追記1 超初心者 09/4/28(火) 13:35 質問
【61343】Re:【61303】の追記1 超初心者 09/4/28(火) 14:04 発言
【61345】Re:【61303】の追記1 Hirofumi 09/4/28(火) 16:43 回答
【61346】Re:【61303】の追記1 Hirofumi 09/4/28(火) 16:49 回答
【61349】Re:【61303】の追記1 超初心者 09/4/29(水) 11:16 お礼

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