メールで、
>入力フォームを書籍からコピーして
>色々な本を広げていますがこれ以上は進みません
>EXCELのフォームでAccessフォームの様なレコード移動ボタンを付けたフォームを
>作っています
>
>問題はオプションボタンの結果の処理をG列に反映させることと
と、質問を受けたので、挑戦してみました。
実行可能なファイルは :
http://www.ken3.org/vba/zip/qa20100602.html
↑にExcel2003ですが、置いてあります。使ってみて小細工を笑ってください。
G列に
入院形態
○任意入院
○医療保護入院
○措置入院
○応急入院
○緊急措置
をセットする感じでテストしてみました。
データセット処理
グローバル変数 DestRow で現在の行数をカウントしているみたいだったので、
単純にデータのセットは、
Private Sub OptionButton1_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton1.Caption End Sub Private Sub OptionButton2_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton2.Caption End Sub
みたいに、押された_Clickのイベントで、.Captionをセットしただけです。
オプションボタンの結果の処理をG列に転記させるそんなテスト動画。
テストの動画: http://www.youtube.com/watch?v=3imcxqHdoZg
www.youtube.com
↑これだけだと、
オプションボタンをクリックでデータ(値)は書き込めたけど、
データの移動処理で何もリンクしていないので、
×選択値がそのまま
×移動した値がフォームに選択されない
そんな 移動後の処理が必要だと気が付いた・・・
データ移動時のオプションボタン処理
Excel UserForm側でデータを移動したときに、
移動先のG列とオプションボタンをつなげる(On/Offをコントロール)
グローバル変数 DestRow で現在の行数をカウントしているので、
初めに全てのボタンをOFFにしてから、G列の値を比べてONにしてみました。
'G列の値で オプションボタンをチェック '全てOFFにする OptionButton1.Value = False OptionButton2.Value = False OptionButton3.Value = False OptionButton4.Value = False OptionButton5.Value = False '元々あるGの値をチェックする strRang = "G" & DestRow If OptionButton1.Caption = Range(strRang) Then OptionButton1.Value = True If OptionButton2.Caption = Range(strRang) Then OptionButton2.Value = True If OptionButton3.Caption = Range(strRang) Then OptionButton3.Value = True If OptionButton4.Caption = Range(strRang) Then OptionButton4.Value = True If OptionButton5.Caption = Range(strRang) Then OptionButton5.Value = True
↑特に工夫もなく、縦に並べただけです・・・(ぉぃぉぃ)
テストの動画: http://www.youtube.com/watch?v=y1KMsJTihLg
http://www.youtube.com/watch?v=y1KMsJTihLg:embed:cite:h385
ソース全体
実行可能なファイルは :
http://www.ken3.org/vba/zip/qa20100602.html
↑にExcel2003ですが、置いてあります。使ってみて小細工を笑ってください。
Option Explicit Dim FirstRow As Long Dim LastRow As Long Dim DestRow As Long 'オプションボタンがクリックされたら単純にG列にそのボタンの.Captionをセットする Private Sub OptionButton1_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton1.Caption End Sub Private Sub OptionButton2_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton2.Caption End Sub Private Sub OptionButton3_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton3.Caption End Sub Private Sub OptionButton4_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton4.Caption End Sub Private Sub OptionButton5_Click() Dim strRang As String strRang = "G" & DestRow Range(strRang) = Me.OptionButton5.Caption End Sub Private Sub 削除_Click() Dim strRang As String strRang = "A" & DestRow & ":ZZ" & DestRow If MsgBox(Range("C" & DestRow).Value & " 様を削除します。", vbYesNo) = vbNo Then Exit Sub 'NOの時削除中止(Ken3蛇足で勝手に追加) End If Rows(DestRow).Delete '行削除 DestRow = DestRow - 1 LastRow = LastRow - 1 LinkCell End Sub Private Sub UserForm_Initialize() Worksheets("会員リスト").Select FirstRow = Range("A1").CurrentRegion.Row + 1 LastRow = Range("A1").CurrentRegion.Rows.Count DestRow = FirstRow LinkCell End Sub Private Sub 先頭_Click() DestRow = FirstRow LinkCell End Sub Private Sub 前_Click() If DestRow > FirstRow Then DestRow = DestRow - 1 LinkCell End If End Sub Private Sub 後_Click() If DestRow < LastRow Then DestRow = DestRow + 1 LinkCell End If End Sub Private Sub 最後_Click() DestRow = LastRow LinkCell End Sub Private Sub 新規_Click() LastRow = LastRow + 1 DestRow = LastRow LinkCell End Sub Sub LinkCell() Dim strRang As String Rows(DestRow).Select '行選択、蛇足で追加 Ken3 strRang = "A" & DestRow TextBox1.ControlSource = strRang strRang = "B" & DestRow TextBox2.ControlSource = strRang strRang = "C" & DestRow TextBox3.ControlSource = strRang strRang = "D" & DestRow TextBox4.ControlSource = strRang strRang = "E" & DestRow TextBox5.ControlSource = strRang strRang = "F" & DestRow TextBox6.ControlSource = strRang 'G列の値で オプションボタンをチェック '全てOFFにする OptionButton1.Value = False OptionButton2.Value = False OptionButton3.Value = False OptionButton4.Value = False OptionButton5.Value = False '元々あるGの値をチェックする strRang = "G" & DestRow If OptionButton1.Caption = Range(strRang) Then OptionButton1.Value = True If OptionButton2.Caption = Range(strRang) Then OptionButton2.Value = True If OptionButton3.Caption = Range(strRang) Then OptionButton3.Value = True If OptionButton4.Caption = Range(strRang) Then OptionButton4.Value = True If OptionButton5.Caption = Range(strRang) Then OptionButton5.Value = True Label1.Caption = DestRow - 1 & " / " & LastRow - 1 End Sub