VBAでコンボボックスの変更によるエラーを解決する方法

このQ&Aのポイント
  • VBAでコンボボックスの値の変更によって発生するエラーを解決する方法について教えてください。
  • コンボAの値を変更した際に、コンボBの値を自動的にブランクにするVBAの書き方を教えてください。
  • 現在のコードでは、コンボBの内容がコンボA内にない場合に発生するエラーをハンドリングする方法がわかりません。どのように書けば良いでしょうか。
回答を見る
  • ベストアンサー

accessでテーブルにレコードが存在しなければ

access初心者です 検索フォームにて二つのコンボボックスがあり 片方を選択する(コンボA)ともう一方のコンボボックス(コンボB)が変わるVBAを組んでいます。 両方を選択した状態で検索ボタンを押すとレポートが出るようにしてるのですが 1)コンボAに入力後、コンボBを選択 2)その後コンボAを変更するとコンボBは1)の状態 3)そのまま検索を押すとブランクのレポートが出てくる *コンボBの内容がコンボA内に無いため この状態を解決したく、エラートラップかコンボA変更時にコンボBを自動的にブランクに変更 するようにVBAを書きたいのですが、書き方が分かりません。 分かりにくい文章で申し訳ございませんが ご教授お願いいたします。 現状のコードだけ乗っけていきます Private Sub コマンド18_Click() Dim report_name As String Dim report_value As String On Error GoTo error_1 If Not IsNull(コンボ50.Value) = True Then report_name = コンボ48.Value report_value = コンボ50.Value DoCmd.OpenReport report_name, acViewPreview, , "[現場名]='" & report_value & "'" Else MsgBox "項目を選択してください。" End If Exit Sub error_1: MsgBox "項目が存在しません。" Resume Next End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • chie65535
  • ベストアンサー率43% (8514/19356)
回答No.1

コンボ48の「変更時」のイベントプロシージャに Private Sub コンボ48_Change() コンボ50.SetFocus コンボ50.Text = "" コンボ48.SetFocus End Sub のコードを割り当てて下さい。

yon3yon3
質問者

お礼

ありがとうございます!! そうです!まさにそれです! エラートラップは外して、エラーの無いコードに出来ました!!

関連するQ&A

  • アクセス 開いているレポート名を取得する。

    アクセス初心者です。 VBAにて フォーム1でレポート、レコードを選択後に レポートを開くと同時に印刷フォームも開くように組んでます。 その印刷フォームで印刷をすると、印刷フォーム自体が印刷されてしまうので ”レポート名”を認識させてから印刷しています。 その時の”レポート名”を開いたときに自動的に変数として印刷フォームに引き継ぎたいのですが やり方が分かりません。 意図としては、印刷フォームを汎用的に使いたいためです。 印刷フォームの呼び出しコードは下記にて Private Sub コマンド18_Click() Dim report_name As String Dim report_value As String If Not IsNull(コンボ50.Value) = True Then report_name = コンボ48.Value  ’レポート名です report_value = コンボ50.Value DoCmd.OpenReport report_name, acViewPreview, , "[現場名]='" & report_value & "'" DoCmd.MoveSize Width:=10000, Height:=13000 Reports(report_name).ZoomControl = 75 Else MsgBox "項目を選択してください。" End End If DoCmd.OpenForm "印刷_フォーム", acNormal End Sub Private Sub コマンド53_Click() Dim new_date As String Dim form_name As String If Not IsNull(コンボ48.Value) = True Then form_name = コンボ48.Value DoCmd.OpenForm form_name, acNormal, , , acFormAdd DoCmd.MoveSize Width:=12000, Height:=13000 Else MsgBox "[取引先名]を入力してください。" End If End Sub 下記は印刷フォームにて、印刷設定をする場合のコードです Private Sub コマンド0_Click() Dim report_name As String report_name = "レポート名" On Error Resume Next DoCmd.SelectObject acReport, report_name, True DoCmd.RunCommand acCmdPrint End Sub

  • access 検索用フォームにてコンボボックスで何も選ばなかったときに全件表示させる方法

    access2003において、 検索用のフォームを作成し、コンボボックスにて検索内容を選択し、 決定ボタンにて他のフォーム画面へ検索結果を表示するようにしています。 この際、検索用フォームには複数のコンボボックスを用いてますが、 そのうちいくつかのコンボボックスを選択せずに決定ボタンを押した際に選択していないコンボボックスの内容については全件表示させたいと考えております。 例)コンボA=会社 コンボB=支店 コンボC=社員 コンボAのみ特定の会社を選択し、コンボB、コンボCは未選択だった場合、コンボAで選択した会社の支店・社員を全件表示したいのです。 お知恵をお貸し下さい。 以下VBAのソースです Private Sub cmdSearch_Click() On Error GoTo Err_cmdSearch_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "F_検索" stLinkCriteria = "[会社CD]=" & Me![会社] & "And [支店CD]=" & Me![支店] & "And [社員CD]=" & Me![社員] DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_cmdSearch_Click: Exit Sub Err_cmdSearch_Click: MsgBox Err.Description Resume Exit_cmdSearch_Click End Sub

  • Range.Name プロパティの使い方

    VBAの勉強中のものです。(エクセル) 一つ一つヘルプを見て、検証して勉強していこうと思ってるのですが 使い方がわからないので教えてください。 Range.Value プロパティならうまくいくのですが、 Range.Name プロパティの使い方がわかりません。 ----------------------- Sub test1() MsgBox Range("a1").Name End Sub Sub test2() Dim R As Range Set R = Range("a1") MsgBox R.Name End Sub ----------------------- どちらも、アプリケーション定義またはオブジェクト定義のエラーです。になります。 ----------------------- Sub test1() MsgBox Range("a1").Value End Sub Sub test2() Dim R As Range Set R = Range("a1") MsgBox R.Value End Sub ----------------------- rangeにすればうまくいきます。 Range.Name プロパティの使い方を教えてください。アドバイスよろしくお願いします。

  • 配列のメリットは?

    下記のコードは同じ動作をします。 Sub 普通() Dim moji1 As String Dim moji2 As String moji1 = Range("a1").Value moji2 = Range("a2").Value MsgBox moji1 & moji2 End Sub --------------------------------------------- Sub 配列() Dim moji(2) As String moji(1) = Range("a1").Value moji(2) = Range("a2").Value MsgBox moji(1) & moji(2) End Sub こういう場合は配列を使ったほうがいいのでしょうか? それとも配列は避けたほうがいいのでしょうか?

  • (VBA) 同名フォルダーの存在をチェック

    以下のコード(Sub ⑤フォルダー名の変更())でフォルダー名の変更を行っています。 変名時に同名ファイルがある場合エラーが以下のコードでエラーがでます。   .GetFolder(Range("A2").Text & Range("B" & i).Text).Name = Cells(i, LastColumn).Text エラー無く処理したいので  同名があるばあいは、フォルダー名の末尾に(1)、(2)を付加したいのですが  同名があるかどうかは?どのように判定しますか ? Sub ⑤フォルダー名の変更() Dim i As Long Dim LastColumn As Single Dim LastColumn_ABC As String Dim MSG As String LastColumn = Cells(5, "B").End(xlToRight).Column LastColumn_ABC = Split(Cells(1, LastColumn).Address, "$")(1) MSG = MsgBox("B列フォルダー名が" & LastColumn_ABC & "列フォルダー名に変更されます!" & vbCrLf _ & "B," & LastColumn_ABC & "列に値がなければ、処理は行いません。", 257, "フォルダー名変更") If MSG = vbCancel Then Exit Sub i = 5 'subフォルダ名取得が5行目からフォルダー名を表示するため。 Do While Range("b" & i).Text <> "" If Cells(i, LastColumn).Text <> "" Then ' 新フォルダー名がある場合のみ、名前変更を行う。 With CreateObject("Scripting.FileSystemObject") .GetFolder(Range("A2").Text & Range("B" & i).Text).Name = Cells(i, LastColumn).Text End With End If i = i + 1 Loop MsgBox "変名処理が終了しました。" End Sub

  • Const に dim は使えない?

    標準モジュールに ''''''''''''''''''''''''''''''''''''''''''' Dim Const moji As String = "a" Sub test1() MsgBox moji End Sub Sub test2() Dim Const moji As String = "a" MsgBox moji End Sub ''''''''''''''''''''''''''''''''''''''''''' とするとエラーになりますが ''''''''''''''''''''''''''''''''''''''''''' Public Const moji As String = "a" Sub test3() MsgBox moji End Sub ''''''''''''''''''''''''''''''''''''''''''' なら大丈夫です。 Const に対してdimは使えないのでしょうか?

  • アクセス(access)からエクセルにエクスポート

    アクセスから、エクセルにクエリのデータを出力する際に、 「TransferSpreadsheet」を使用していますが、 そのエラー処理について、教えて下さい。 保存しようとしているファイルが既に開かれている場合に、 処理を中止し、エラーメッセージを出したいのですが、 どのようにすればいいのでしょうか? なお、現在のVBAは次のとおりです。 Private Sub コマンド01_Click() Dim a As String Dim b As Variant a = "Q_一覧表" b = "C:\一覧表.xls" DoCmd.TransferSpreadsheet acExport, _ acSpreadsheetTypeExcel9, a, b, True MsgBox "データを出力しました。" Exit Sub End Sub

  • エクセルテーブルをアクセステーブル取込む

    エクセルで作成したテーブルデータを取り込むときに余分に空白のレコードが取り込まれてしまうんですが原因が分かりません。 下記コードで処理してます。 Dim strac As String Dim strxls As String Dim strrange As String Dim strMsg As String strac = "T_障害票マスタ" 'Accessテーブルを指定します。 strxls = テキスト0 'エクセルファイルを指定します。 strrange = "T_障害票!" 'データ入力のシート名とセル範囲を指定します。 strMsg = "エクセルファイル" & strxls & " を、Accessファイル " & strac & _ "として、データ入力を行います。" & _ "よろしければ、OKをクリックして下さい。" 'MsgBoxのメッセージ If strxls = "" Then MsgBox "ファイルを選択して下さい。" 'テキストボックスの確認 Exit Sub End If 'DoCmd.DeleteObject acTable, strac 'テーブルを削除します。 If MsgBox(strMsg, vbOKCancel, "import") = vbOK Then '最初のデータをフィールド名として使います。 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _ strac, strxls, True, strrange MsgBox "インポートは、正常に完了しました。" End If Exit Sub なお取り込むテーブルデータはフィールド行を抜かして常に1レコードだけです。 アクセスでは既存のテーブルに保存してます。 詳しい方お願いします。

  • accessについて<BOFとEOFのいずれかがTUREになっているか・・・現在のレコードが必要です>

    Private Sub kensaku_Click() On Error GoTo Err_kensaku_Click Screen.PreviousControl.SetFocus Dim ss As String Dim rs As String Dim strSQL As String Dim rstType As ADODB.Recordset Set rstType = New ADODB.Recordset ss = text.text strSQL = "Select 見積日 From 見積 where 提出見積No ='" & ss & "'" rstType.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText If ss = "" Then MsgBox ("提出見積Noを入力してください") ElseIf rstType.EOF = False Then While rstType.EOF = False rs = rstType.GetString MsgBox (rs) rstType.MoveNext Wend kikaiNo.Value = "222" Else MsgBox ("提出見積Noが存在しません") End If Exit_kensaku_Click: Exit Sub Err_kensaku_Click: MsgBox Err.Description Resume Exit_kensaku_Click End Sub 以上は書いた検索のコードですが、<BOFとEOFのいずれかがTUREになっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です>というエラーが出てきます。問題がどうかよくわかりませんので、教えていただけませんか。

  • EXCEL VBA コンボボックス、テキストボックスが未入力のときメッセージを表示する方法

    ユーザーフォームにコンボボックス2個textboxが2個あります コンボは選択のみです。 コンボとtextbox1は入力必須にして、空欄でコマンドボタンが押された時はメッセージを表示したいです OKwebを参考に作ったのですが、コンボ1が空欄でもMsgが出ません 願いします Private Sub CommandButton1_Click() Dim ctrl As Control, tst1 As String, txt2 As String Dim ws As Worksheet Set ws = Sheets("sheet1") For Each ctrl In Me.Controls Select Case ctrl.Name Case "ComboBox1", "ComboBox2", "TextBox1" If Me.Controls(ctrl.Name).Value = "" Then txt1 = txt1 & ctrl.Name & vbLf Else txt2 = txt2 & Me.Controls(ctrl.Name).Value & vbLf End If End Select Next If Len(txt1) > 0 Then MsgBox "以下の値を入力してください" & vbLf & txt1, vbExclamation Exit Sub Else ret = MsgBox("以下の値を入力します" & vbLf & txt2, vbOKCancel) If ret <> vbOK Then Exit Sub

専門家に質問してみよう