システムメンテナンスのお知らせ

添付のユーザーフォームから入力してsheet1に反映させたいです。
自分で組んでも上手くいきません。本当は勉強のために自分でデバックから手直ししていくのが一番いいのですが、今回は時間が(仕事の締め切りが)迫っているので丸投げでお願いしたいと思います。

*種別を選択してない場合はMsg「種別が選択されてません」で選択しない場合は登録できないようにしたい
*種別を選択したらsheets1のC列に「レギュラー・ハイオク・軽油」の文字を登録したい
*登録ボタンをクリックしたらsheets1に反映させて、入力した値をクリアしたあと続けて入力を進めたい
*終了ボタンをクリックしたら「終了しますか?」のMsgで「はい」でフォームを閉じる

以上です。

本当に丸投げで申し訳ないのですが、どなたかご教授ください。

「vba ユーザーフォームから入力する」の質問画像
gooドクター

A 回答 (5件)

こんばんは。



あれもこれも考えてしまい、すぐに書き込みできなかったことをお詫びします。
今、設定していないのは、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
    • good
    • 0
この回答へのお礼

色々と考えて下さって有難う御座います。
実行は問題なく出来ました。コードが何を意味するのかのコメントまで入れて頂いたので勉強する際に助かります。
ところで・・・都合でコピペするセルがA3からとなったのですが、どこを修正したら良いでしょうか?自分では印刷や簡単なコードしか組めないレベルです・・・。丸投げで本当に申し訳ありません。

お礼日時:2015/04/15 09:24

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



>Cells(j, i).Value = Me.Controls("TextBox" & k).Value  この部分で「指定されたオブジェクトは見つかりません」となります。

要するに、私が書いたコードは、オブジェクト類は、手付かずのデフォルト状態で作られていますから、それをご自身が加工されている場合には、今のコードは直さないと動かないのです。

>テキストボックスは「text1」「text2」「text3」という名前になっています。
Excelでお使いになるなら、コードは、Me.Controls("Text" & k).Value と換えれば済むことですが、私からすると、わざわざVB仕様の名称にしているのは、逆に、なぜなのかなと素朴な疑問を持ちました。

結局のところは、残念ながら、動いていないようですね。
たぶん、期限つきの完成も、流れてしまったかもしれませんが、これ以上、あちこちでエラーが出て、私が書いたコードの修正ができないすれば、私のコードではダメかもしれません。

どこか一点を絞って、解決するような方向にしていったほうがよいかもしれませんね。
    • good
    • 0
この回答へのお礼

何度も何度もすみませんでした。
締め切りがありましたので、今回はエクセルシートへの直接入力で集計し、手が空いている時にこのコードを修正して使用できるようにしたいです。
簡単なコードしか書けない私のレベルを遥かに超えているものですが、勉強を兼ねてエラー対応したいと思っています。

お礼日時:2015/04/18 08:57

こんにちは。



掲示板の回答のコードを、[ユーザーフォーム]モジュールの、一番上の行から入れ換えてみましたが、問題が発生しません。というよりも、最初の行の

 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
'///

'添付画像は、エラーになる場合の例(これは、綴りを間違えた時などにでるエラーです。)
「vba ユーザーフォームから入力する」の回答画像4
    • good
    • 0
この回答へのお礼

度々すみません。
Cells(j, i).Value = Me.Controls("TextBox" & k).Value  この部分で「指定されたオブジェクトは見つかりません」となります。
テキストボックスは「text1」「text2」「text3」という名前になっています。
コード内は全てコピペしてあるので変更はしていないのですが・・・
何故なのでしょうか?

お礼日時:2015/04/17 09:45

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


#2の最初の1行が抜けていました。
その1行を加えて様子をみてください。

'//
Private Ar As Variant  '←この行を写し損ねました。
Private rOil As Range '種別の書き込み場所
Private cmbFlg As Boolean
    • good
    • 0
この回答へのお礼

加えてみましたが、SubまたはFunctionが定義されていませんとなります。
本当に何度も申し訳ありません。

お礼日時:2015/04/16 11:59

こんにちは。



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

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

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

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

このブラインドタッチ(タッチタイプ)については、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
    • good
    • 0
この回答へのお礼

度々のご回答ありがとうございます。
実行してみたところ、下記の矢印の箇所でエラーになります。
SubまたはFunctionが定義されていませんのメッセージがでます。


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)←Arの所
   End If
   If KeyCode = 13 And flg Then CommandButton1.SetFocus
End Sub

お礼日時:2015/04/15 15:55

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

人気Q&Aランキング