vba　ユーザーフォームから入力する

Question

添付のユーザーフォームから入力してsheet１に反映させたいです。
自分で組んでも上手くいきません。本当は勉強のために自分でデバックから手直ししていくのが一番いいのですが、今回は時間が（仕事の締め切りが）迫っているので丸投げでお願いしたいと思います。

＊種別を選択してない場合はMsg「種別が選択されてません」で選択しない場合は登録できないようにしたい
＊種別を選択したらsheets１のC列に「ﾚｷﾞｭﾗｰ・ﾊｲｵｸ・軽油」の文字を登録したい
＊登録ボタンをクリックしたらsheets１に反映させて、入力した値をクリアしたあと続けて入力を進めたい
＊終了ボタンをクリックしたら「終了しますか？」のMsgで「はい」でフォームを閉じる

以上です。

本当に丸投げで申し訳ないのですが、どなたかご教授ください。

WindFaller · Accepted Answer

こんばんは。

あれもこれも考えてしまい、すぐに書き込みできなかったことをお詫びします。
今、設定していないのは、TextBox1 のIsDate(TextBox1.Text)で、日付が入力されたかのチェックがなされていません。それぞれのテキストボックスの入力文字のチェックはしたほうがよいと思います。

私の書いた内容の重要な部分は、二度打ちの防止と、一旦入力した後、UserFormからの修正ができるようにしたということです。なお、画像の文字が見える所とそうでない所がありますが、こちらの想像で設定しました。

「日付・ナンバー・種別・給油量」というところまでです。

'//userfrom モジュール

Private Ar As Variant
Private rOil As Range　'種別の書き込み場所
Private cmbFlg As Boolean　'二度打ち防止のFlag

Private Sub CommandButton1_Click()
'登録ボタン
　Dim i As Long, j As Long, k As Long
　Dim sOil As String
　'二重登録の防止
　If cmbFlg = True Then
　 If MsgBox("次の行に移りますか？", vbQuestion + vbOKCancel) = vbOK Then
　　 Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
　　 cmbFlg = False
　 End If
　End If
　sOil = ""
　Set rOil = Nothing
　Ar = Array("レギュラー", "ハイオク", "軽油")
　For i = 0 To 2
　　If Me.Frame1.Controls(i).Value = True Then
　　　sOil = Ar(i)
　　　Exit For
　　End If
　Next i
　If i > 2 Then
　　MsgBox "種別が選択されてません", vbExclamation
　　Exit Sub
　Else
　　k = 1
　　For i = 1 To 4
　　　If i = 3 Then
　　　　Cells(j, i).Value = sOil
　　　　Set rOil = Cells(j, i)
　　　Else
　　　j = Cells(Rows.Count, 1).End(xlUp).Row
　　　Cells(j, i).Value = Me.Controls("TextBox" & k).Value
　　　'テキストボックスから修正ができるようにする
　　　Me.Controls("TextBox" & k).ControlSource = Cells(j, i).Address
　　　k = k + 1
　　　End If
　　Next i
　End If
　cmbFlg = True
End Sub

Private Sub Frame1_Mousemove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'フレームの中のオプションボタンの変更があった時
Dim i As Long
If IsArray(Ar) And Not rOil Is Nothing Then
　For i = 1 To 3
　　If Me.Frame1.Controls("OptionButton" & i).Value Then
　　　rOil.Value = Ar(i - 1)
　　　Exit For
　　End If
　Next
　End If
End Sub
Private Sub CommandButton2_Click()
'終了ボタン
　If MsgBox("終了しますか？", vbQuestion + vbOKCancel) = vbOK Then
　　Unload Me
　End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　'右上のボタンで直接には終わらせない
　If CloseMode = 0 Then
　 Cancel = True
　End If
End Sub

WindFaller · Answer

今日は、返事が遅くなりました。

>Cells(j, i).Value = Me.Controls("TextBox" & k).Value　　この部分で「指定されたオブジェクトは見つかりません」となります。

要するに、私が書いたコードは、オブジェクト類は、手付かずのデフォルト状態で作られていますから、それをご自身が加工されている場合には、今のコードは直さないと動かないのです。

>テキストボックスは「text1」「text2」「text3」という名前になっています。
Excelでお使いになるなら、コードは、Me.Controls("Text" & k).Value と換えれば済むことですが、私からすると、わざわざVB仕様の名称にしているのは、逆に、なぜなのかなと素朴な疑問を持ちました。

結局のところは、残念ながら、動いていないようですね。
たぶん、期限つきの完成も、流れてしまったかもしれませんが、これ以上、あちこちでエラーが出て、私が書いたコードの修正ができないすれば、私のコードではダメかもしれません。

どこか一点を絞って、解決するような方向にしていったほうがよいかもしれませんね。

WindFaller · Answer

こんにちは。

掲示板の回答のコードを、[ユーザーフォーム]モジュールの、一番上の行から入れ換えてみましたが、問題が発生しません。というよりも、最初の行の

　Private Ar As Variant

 を入れないと、UserFormが立ち上がらなかったはずです。ところが、そうでない所をみると、何か別のものが混じっている可能性がありますね。

しかし、仮にそうでも、「SubまたはFunctionが定義されていません。」という、変数が認識されないということはないはずです。

そのエラーで、Arの部分を指す場合は、手書きで入れた場合など、別の文字が混じっていることです。もし、モジュール内のコード全取替が可能なら、1行目を加えて#2の内容を全部を入れ替えてみてください。なお、コントロール名は、標準の名称に限ります。

また、部分だけを使うというのは、せいぜい、終了ボタンの所ぐらいです。他は、複雑に入り組んでいますから、どれを残すということは難しいと思います。


'//
Option Explicit

Private Ar As Variant
Private rOil As Range  '種別の書き込み場所
Private cmbFlg As Boolean
Private Sub CommandButton1_Click()
'登録ボタン
  Dim i As Long, j As Long, k As Long
  
～
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  '右上のボタンで直接には終わらせない
  If CloseMode = 0 Then
   Cancel = True
  End If
End Sub
'///

'添付画像は、エラーになる場合の例（これは、綴りを間違えた時などにでるエラーです。）

WindFaller · Answer

たいへん、すみませんでした。
#2の最初の1行が抜けていました。
その1行を加えて様子をみてください。

'//
Private Ar As Variant　　'←この行を写し損ねました。
Private rOil As Range  '種別の書き込み場所
Private cmbFlg As Boolean

WindFaller · Answer

こんにちは。

>都合でコピペするセルがＡ３からとなったのですが、どこを修正したら良いでしょうか？

そういう指摘で初めて気が付きました。丸っきり最初のスタート部分がありませんね。既存のものという考え方だったので、考えていませんでした。これはまずかったです。修正点は　※　の部分です。

実用段階には、もう一歩のところまで来ているはずです。

あちこち、私なりに工夫してみました。だから、私の癖みたいなものですから、嫌だったら、取り外してください。シンプル・イズ・ベストですが、マウスを使わずに、テンキーだけで、ブラインドタッチ（タッチタイプ）できるようにしたのです。このテンキーは、フレーム内のフォーカスをされていないと、オプションボタンのキー入力はできません。　※※

このブラインドタッチ（タッチタイプ）については、UserForm 内のそれぞれのコントロールのプロパティのTabIndex は、入力順にしておいてくださいね。TextBox 1～3, Frame1、次は、CommandButton1 です。

種別のオプションボタンで入力した後に、修正を掛け、違う種別にする時に、遅い反応だったのを修正　※※※

A列の書式を日付にすると同時に、日付の部分の工夫は施したほうがよいかもしれません。

今回は、コード全部、入れ替えたほうがよいと思います。
暇があったら、ステップインで、ひとつずつ調べてください。考え方だけ分かれば、後は、ご自身でなんとか完成にこぎつけるはずです。

'//
Private rOil As Range　'種別の書き込み場所
Private cmbFlg As Boolean
Private Sub CommandButton1_Click()
'登録ボタン
　Dim i As Long, j As Long, k As Long
　Dim sOil As String
　'二重登録の防止
　If cmbFlg = True Then
　 If MsgBox("次の行に移りますか？", vbQuestion + vbOKCancel) = vbOK Then
　　 j = Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
　　 Cells(j, 1).Select
　　 For i = 1 To 3
　　　 'テキストボックスのクリア
　　　 With Me.Controls("Textbox" & i)
　　　　 .Text = ""
　　　　 .ControlSource = ""
　　　 End With
　　　 'オプションボタンのクリア
　　　 With Me.Frame1.Controls(i - 1)
　　　　 .Value = False
　　　 End With
　　 Next i
　　 Set rOil = Nothing　'種別セルの解放
　　 cmbFlg = False
　　 TextBox1.SetFocus
　　 Exit Sub
　 End If
　Else
　　'スタート時の行の選択(3行目以上から）※
　　j = Cells(Rows.Count, 1).End(xlUp).Row + 1
　　If j < 3 Then
　　　　Cells(3, 1).Select
　　　　j = 3
　　Else
　　　　Cells(j, 1).Select
　　End If
　End If
　sOil = ""
　Set rOil = Nothing
　For i = 0 To 2
　　If Me.Frame1.Controls(i).Value = True Then
　　　sOil = Ar(i)
　　　Exit For
　　End If
　Next i
　If i > 2 Then
　　MsgBox "種別が選択されてません", vbExclamation
　　Exit Sub
　Else
　　k = 1
　　For i = 1 To 4
　　　If i = 3 Then
　　　　Cells(j, i).Value = sOil
　　　　Set rOil = Cells(j, i)
　　　Else
　　　Cells(j, i).Value = Me.Controls("TextBox" & k).Value
　　　'テキストボックスから修正ができるようにする
　　　Me.Controls("TextBox" & k).ControlSource = Cells(j, i).Address
　　　k = k + 1
　　　End If
　　Next i
　End If
　cmbFlg = True
End Sub

Private Sub OptionButton1_Click()
'直接入力の場合 ※※※
　　If Not rOil Is Nothing Then
　　 rOil.Value = Ar(0)
　　End If
End Sub
Private Sub OptionButton2_Click()
'直接入力の場合
　 If Not rOil Is Nothing Then
　　rOil.Value = Ar(1)
　 End If
End Sub
Private Sub OptionButton3_Click()
'直接入力の場合
　 If Not rOil Is Nothing Then
　　rOil.Value = Ar(2)
　 End If
End Sub

Private Sub OptionButton1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　 'テンキー入力: 1がレギュラー, 2がハイオクと選択できる,3軽油　※※
Dim flg As Boolean
Dim i As Long, j As Long
　 If ActiveControl.Name <> "Frame1" Then Exit Sub
　 If KeyCode = 97 Then OptionButton1.Value = True: j = 1
　 If KeyCode = 98 Then OptionButton2.Value = True: j = 2
　 If KeyCode = 99 Then OptionButton3.Value = True: j = 3
　
　 'エンターを入れると、次のボタンにフォーカスを移す
　 For i = 1 To 3
　　 If Me.Controls("OptionButton" & i).Value = True Then
　　　 flg = True
　　 End If
　 Next i
　　 If j > 0 And Not (rOil Is Nothing) Then
　　　 rOil.Value = Ar(j - 1)
　　 End If
　　 If KeyCode = 13 And flg Then CommandButton1.SetFocus
End Sub

Private Sub CommandButton2_Click()
'終了ボタン
　If MsgBox("終了しますか？", vbQuestion + vbOKCancel) = vbOK Then
　　Unload Me
　End If
End Sub

Private Sub UserForm_Initialize()
'オプションボタンの内容の設定
　Ar = Array("レギュラー", "ハイオク", "軽油")
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
　'右上のボタンで直接には終わらせない
　If CloseMode = 0 Then
　 Cancel = True
　End If
End Sub

vba ユーザーフォームから入力する

こんばんは。

今日は、返事が遅くなりました。

こんにちは。

たいへん、すみませんでした。

こんにちは。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

vba　ユーザーフォームから入力する