Private Sub opt_洋or和_AfterUpdate()
SetComboBoxRowSource
End Sub
Private Sub opt_洋or和_AfterUpdate()
SetComboBoxRowSource
End Sub
Private Sub SetComboBoxRowSource()
Dim stSQL As String
Select Case Me.opt_洋or和.Value
Case 1
stSQL = " AND 洋or和 = '洋菓子'"
Case 2
stSQL = " AND 洋or和 = '和菓子'"
End Select
Select Case Me.opt_生or焼.Value
Case 1
stSQL = stSQL & " AND 生or焼 = '生菓子'"
Case 2
stSQL = stSQL & " AND 生or焼 = '焼菓子'"
End Select
If stSQL = "" Then
stSQL = "SELECT * FROM M_商品;"
Else
stSQL = "SELECT * FROM M_商品 WHERE" & Mid(stSQL, 6) & ";"
End If
Me.サブフォーム1.Form!コンボボックス1.RowSource = stSQL
End Sub
SELECT [Mtbl_社員].*
FROM [Mtbl_社員]
INNER JOIN
(SELECT tmp.[社員コード]
FROM [Mtbl_社員] AS tmp
GROUP BY tmp.[社員コード]
HAVING Count(*) > 1) AS [兼任社員抽出クエリ]
ON [Mtbl_社員].[社員コード] = [兼任社員抽出クエリ].[社員コード]
ORDER BY [Mtbl_社員].[社員コード];
Dim reportName As String
Dim rs As Recordset
reportName = "R_Report"
DoCmd.OpenReport reportName, acViewPreview, , , acHidden
Set rs = CurrentDb.OpenRecordset(Reports(reportName).RecordSource, , acReadOnly)
If rs.EOF Then
DoCmd.Close acReport, reportName
Else
Reports(reportName).Visible = True
End If
rs.Close
Private Sub btn_1_Click()
On Error Resume Next
DoCmd.OpenReport "R_Report1", acViewPreview
DoCmd.OpenReport "R_Report2", acViewPreview
DoCmd.OpenReport "R_Report3", acViewPreview
On Error GoTo 0
End Sub
ただ、いまさらですが、
On Error Resume Next にしてしまうと、どんなエラーでも無視してしまうので、
空データ以外のエラーが発生した場合、気がつかないので推奨しません。
コード例
Private Sub btn_1_Click()
On Error GoTo ErrorHandler
DoCmd.OpenReport "R_名簿", acViewPreview, , "ID=0"
DoCmd.OpenReport "R_Report1", acViewPreview
DoCmd.OpenReport "R_Report2", acViewPreview
DoCmd.OpenReport "R_Report3", acViewPreview
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 2501 '空データエラー時
'何もしない
Case Else
MsgBox "予期せぬエラーが発生しました" & vbCrLf & Err.Number & ":" & Err.Description
End Select
End Sub
Private Sub btn_1_Click()
On Error Resume Next
DoCmd.OpenReport "R_Report1", acViewPreview
On Error GoTo 0
On Error Resume Next
DoCmd.OpenReport "R_Report2", acViewPreview
On Error GoTo 0
On Error Resume Next
DoCmd.OpenReport "R_Report3", acViewPreview
On Error GoTo 0
End Sub
Option Compare Database
Option Explicit
Private Sub Form_Load()
SetSFList
End Sub
Private Sub cbFilelds_AfterUpdate()
SetSFList
End Sub
Public Sub SetSFList()
Dim strFilelds As String
strFilelds = "ID, F1, " & Me.cbFilelds
CurrentDb.QueryDefs("Qry_名簿").SQL = "select " & strFilelds & " from Mtbl_名簿"
Me.SF1.SourceObject = "クエリ.Qry_名簿"
Me.SF1.Form.OnCurrent = "=CurentEvent()"
End Sub
標準モジュール
Function CurentEvent()
With CodeContextObject
Debug.Print "レコード移動しました！IDは" & !ID
.Parent!テキスト1.Value = !ID
End With
End Function
仕様
サブフォームのリストには ID, F1 フィールドは常に表示
コンボボックスで選択されたフィールドが表示
イベントプロシージャのコードは
Private Subの部分からEnd Subまですべてコピーして貼り付けてください。方法としては下記の２つが考えられます。
コンボボックスの値集合ソースのクエリ(SQL)にメインフォームのオプショングループを参照する抽出条件を設定する。
メインフォームのオプショングループの更新後処理でサブフォームのコンボボックスの値集合ソースのSQLを変更する。
オプションの選択肢が「洋or和」「生or焼」だけなら１.の方法がシンプルだと思います。
例
オプショングループ（opt_洋or和）
オプションボタン(opt_洋) オプション値: 1
オプションボタン(opt_和) オプション値: 2
オプショングループ（opt_生or焼）
オプションボタン(opt_生) オプション値: 1
オプションボタン(opt_焼) オプション値: 2
コンボボックスの値集合ソースの設定
メインフォームのオプショングループの更新後処理
サブフォームコントロール名、コンボボックス名は実際のものに変更
opt_生or焼 も同様に。
オプショングループの選択肢に全て(抽出しない)というのを追加するなら抽出条件が複雑になるので2.の方法をとりますね。
洋,和,全(抽出しない)
例
オプショングループ（opt_洋or和）
オプションボタン(opt_洋) オプション値: 1
オプションボタン(opt_和) オプション値: 2
オプションボタン(opt_全) オプション値: 3
オプショングループ（opt_生or焼）
オプションボタン(opt_生) オプション値: 1
オプションボタン(opt_焼) オプション値: 2
オプションボタン(opt_全) オプション値: 3
メインフォームのモジュール
確かにです、一時テーブルに社員コードだけを格納してINNER JOINですね。
パフォーマンスを落とさず、クエリが読み取り専用になってしまう場合などは、有効ですね。
抽出したデータの閲覧だけならskさんのサブクエリを使う方法でいいと思います。
更新する必要があり、かつ、ストレスなく使いたいという場合は、私なら下記の方法をとります。
下記のような[社員コード]のみの一時テーブルを作成しておきます。
テーブル名: Tmp_兼任社員コード
フィールド: 社員コード (主キー)
下記のクエリを順次実行します。
削除クエリ: 一時テーブルのデータを削除
追加クエリ: 一時テーブルに兼任社員コードを追加
兼任社員抽出クエリ
やっていることはskさんのSQLのサブクエリ部分を一時テーブルにしただけです。
これでストレスフリーで編集作業も可能になります。
ありがとうございます。
最初、Dcountが直感的にはやりやすいので思い浮かびましたが、
これまでの経験上、D系を使うとかなりストレスフルなのを感じていましたので、
レコードが2万件くらいあるので、やりずらかったです（なので試してもいなかったです）。
HAVINGのほうは、それほどストレスなく使えました。
下記のSQLでもskさんのクエリと同じ結果を得られます。
メリットとしては、このクエリの場合は編集操作が可能です。
デメリットとしては、データ数が多いとskさんのより重くなる可能性があります。
はいその通りでして、当初ＳＱＬでやろうとして断念し、作業テーブルに書き出したものを、
VBAで削除するしかできませんでした。
すごいですね。これでできてしまうのですか！
こちらを採用させていただきます。
では、以下[社員コード]と読み替えます。
単純に「[Mtbl_社員]に格納されているレコードのうち、
[社員コード]の値が同一であるレコード同士を 1 つのグループとみなし、かつ
『レコード件数が 2 件以上であるグループ』に含まれるレコードを抽出したい」
ということでしょうか。
例えば、以上のような選択クエリを作成なされば同様の結果が得られるはずです。
抽出されたレコードに対し、更に何らかの編集操作を行いたい場合は、
上記の選択クエリの結果を同一構造の一時テーブルに出力するように
なさればよいでしょう。
実際のコードとは違いまして、簡略化したコードを載せています。
ご指摘の通り、Noは使っていません。
Noは社員コードの意でして、主キーではありません。
Mtbl_社員（現所属）の社員コードとご理解ください。
簡易チェックのためのテンポラリーの抽出で、所属が専任ではなく、兼任の人を抽出したいという意図があります。
一応、このコードでも削除自体はできていまして、
ただ、あまりいいやり方ではないのかなという懸念と、
最終レコードの社員が1レコードのみの場合の削除ができていないという詰めが甘いです。
ループを回す前に、Movelastをして、最終レコードの社員が1レコードの場合は削除、
MoveFirstとするようなお粗末なやり方を考えました。
Noは Access SQL における予約語の 1 つであり、Yes/No 型（ VBA における Boolean 型）の False 値、
数値型の 0 と同義です。
（最初からそんな名前はつけない方がよいですが）
フィールド名として識別させたいのであれば、[]で囲ってください。
テーブル[Mtbl_社員]の主キーはフィールド[No]である、
という意味だとして、
これはどのテーブルのレコードのことをおっしゃっているのでしょうか。
[No]が主キーであれば、[No]の値が他のレコードと重複するレコードを
テーブル[Mtbl_社員]に格納することは出来ないはずですが。
コードはこちらです。
Funcion keyBreak()
Dim rs As DAO.Recordset
Dim PreNo As Long
Dim strSQL As String
strSQL = "select * from Mtbl_社員 ORDER BY No"
Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbFailOnError)
cnt = 0
Do Until rs.EOF
If PreNo = rs!No Then
cnt = cnt + 1
Else
If cnt = 1 Then
rs.MovePrevious
rs.Delete
rs.MoveNext
End If
PreNo = rs!No
cnt = 1
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Function
ありがとうございます。
あちらでいただいた意見を反映し、T_取引履歴からエントリーメンタルIDとクローズメンタルIDをフィールドから削除しました。
下記で同内容のポストがありますので、そちらで続けてください。
リレーションシップの設定
新規にデータベースを作成して試してみましたが、そのような症状はでないですね
サブフォーム
メインフォーム
メインフォームの実際の表示（アンカー設定でサブフォームを引き延ばし）
見えないようなオブジェクトがあり、それがアンカー設定で引き延ばされると表示されたりするかもしれません
もちろんです。サブフォーム上のテキストボックスの右端とサブフォームの領域の末端は隙間なくぴったり一致しています。メインフォーム上にそのサブフォームを配置し、右端の隙間なく表示させたいのですが、どうしても隙間ができてしまいまして、そこに罫線が自動的に生じてしますので、ご相談をしているという趣旨です。
暫定的には、最右端にデータを表示させないダミーのテキストボックスを列幅広めにして置いて、メインフォーム上の
サブフォームの領域を、本ダミーのテキストボックスの中央くらいまでカットインさせたら、罫線の生じる
領域は無くなりました。
これは必要な領域ですか？
サブフォームの、フォームとしての幅の右端は、配置しているテキストボックスの右端と一致していますか？
（デザインビューでフォームの右端（詳細セクションの右端など）をドラッグして左に移動させると、テキストボックスの右端とそろいますか？）
ありがとうございます。
なるほどです。サブフォームをコントロールとみて、[書式]-[境界線スタイル]プロパティを「透明」ってことですね。
残念ながら、これでも状況は変わりませんでした。
してないです。
詳細セクションの代替の背景色プロパティは「色なし」で、
そこに置くテキストボックスの背景色は白としています。
スクロールバーを表示に変えてみても、最右列のテキストボックスとスクロールバーの間に、
線（行の上面）が表示されます。
メインフォーム上のサブフォームコントロールの[書式]-[境界線スタイル]プロパティを「透明」でどうだろう？
うーん？スクロールバーが表示される領域に表示されるような「線」はそうそうないんですが、各レコードの高さ分で交互にしましまになってるとかですか？
詳細セクションの代替の背景色プロパティに「色なし」以外が設定されていたりしませんか？
ありがとうございます。そこのプロパティは「いいえ」にしてはいます。
フォーム（サブフォーム）の書式の設定の区切り線プロパティを「はい」→「いいえ」にしたらいいかな？
お二方、ありがとうございました。
レコードソース用のクエリを作成し、Dcountでレコードがあるのか判定するのが最もシンプルに書けると思いましたので、こちらを採用しました。
とりあえず回答例を載せておきます
※レポートの空データ時イベントは不要です
ここまでやるとなかなかめんどくさいですね。エラー処理がどういうものかきちんと理解できてるのであれば、空データ時イベント＋エラー処理でもいいと思います
レポートのレコードソースをレポートとフォームのモジュール（VBA）2か所に記述することになると修正のときに困るので、結局レポートを一度開いてしまうことにしました
一度開いてしまうとレポートの表示が入るので最初は非表示で開いてから、データをチェックして表示するように
いろいろ考えてみると、いろいろ細かいことが多くてどこまで反映させるか悩みどころですね。「細かいこと」はバッサリカットです
エラーがでないように事前チェックするか、
エラー処理で対処するか、
どちらがいいかはその時次第でしょうね。
プログラマーの考え方にもよりますが。
空データ時でキャンセルした場合は、実行時エラー2501が出るいう仕様にMSがしたのなら、それをありがたく利用させもらうというのも選択肢の一つです。
レポートのレコードソースプロパティにSQLを設定している場合、DCountでは簡単に件数を取得できないので、
DAOで、SQLからレコードセットを生成してデータ有無を調べるという面倒なことになるので、エラー処理にするほうがシンプルでしょう。
私としては、
事前に件数を取得するためにレコードセットを開き(DCountにしろDAOにしろ)、その後、レポートでレコードセットを開くというのが2度手間という気がするので、空データ時でキャンセルするのを使うことが多いですね。
ありがとうございます。
レポートのレコードソースはクエリビルダーで作成されているのですが、この場合はDAOというものを使う必要があるということでしょうか？
また、このパターンだと、レポートの空データ時イベントは不要になりますか？
もっとも単純な例であれば、レポートのレコードソースに指定しているクエリ（テーブル）から
Dcountでレコード数を取得すればいいですね※レポートのレコードソースに「Q出力」を指定している場合
レポートのレコードソースの作り方によっては
DAOでレコードソースを生成するなどの手法が必要になるかもしれませんわたしもできればそうしたいです。
使うのはDcountでしょうか？
hiroton的にはそもそもエラーを出さないほうが好きですね
先にレポートに表示されるレコードの件数を調べて0ならレポートを開かなければいいので。VBAのエラー処理に悩まされるよりはよっぽど楽だと思います
必要です。ないと、空のレポートが開きます。
複数レポートの場合は、On Error Resume Next は最初に一つだけでもOKです。
ただ、いまさらですが、
On Error Resume Next にしてしまうと、どんなエラーでも無視してしまうので、
空データ以外のエラーが発生した場合、気がつかないので推奨しません。
コード例
ボタンにこのコードを書く場合、レポートの空データ時イベントは不要ですか？
また、複数のレポートを開く場合、レポートの数だけこのエラー処理を書く必要がありますか？下記のような書き方をする必要がありますか？
DoCmd.OpenReport でレポートを開くのに失敗するので実行時エラーが発生します。そういう仕様です。
エラー処理を追加しましょう。
メッセージも何も出さないのなら、
ポイントの通りの順番でやったらできました。
完璧です！
勉強になりました、どうもありがとうごいざいました。
ポイントは、下記ですね。
Me.SF1.Form.RecordSource = "SELECT ・・・・"というようにサブフォームの RecordSource を書き換えてもサブフォームオブジェクトは再生成されない。
Me.SF1.SourceObject = "クエリ.Qry_名簿"というようにソースオブジェクトを設定すると再生成される。
再生成される前にサブフォームのレコードソースのクエリのSQLを書き換えておく。
その後、
Me.SF1.Form.OnCurrent = "=CurentEvent()"というようにイベントを設定する。
簡単なサンプルを作成して動作確認してみました。
テーブル
Mtbl_名簿 (ID, F1, F2, F3, F4)
クエリ Qry_名簿
SELECT ID, F1 FROM Mtbl_名簿;
メインフォーム
テキストボックス テキスト1
コンボボックス cbFilelds
値集合タイプ 値リスト
値集合ソース F2;F3;F4
規定値 "F2"
サブフォームコントロール SF1
ソースオブジェクト 空欄
メインフォームのフォームモジュール
標準モジュール
仕様
サブフォームのリストには ID, F1 フィールドは常に表示
コンボボックスで選択されたフィールドが表示
上記でメインフォームを開くと、ID, F1, F2列が表示されている
レコード移動するとイベントが発生してテキスト1にカレントのIDが表示される
コンボボックスでフィールド名を変更するとサブフォームの表示も変更される
レコード移動イベントも発生する。
というように動作確認できました。
できないと思って原因を探ったところ、
メインフォームの読み込み時に、UserNameによって、見える範囲（列）を動的に設定しています。
あくまで簡易的なアクセス制限ですので、非表示で隠してあるテーブルとかクエリを直接見ることはできるのですが。
具体的には、これが影響していると思われます。
サブフォームコントロールのレコードソース：Qry_名簿です。
UserNameに応じて、見せる属性をstrFileldsで生成して、クエリを置き換えています。
currentdb.QueryDefs("Qry_名簿").SQL="select " & strFilelds & " from Mtbl_名簿"
Me.サブフォームコントロール名.form.recordSource = "select * from Qry_名簿"
Me.サブフォームコントロール名.Form.OnCurrent = "=CurentEvent()" ←------この場所で入れてもダメですか？
上記の動的に変えているところを削除すると、イベントが発生することは画にしました。
人により、列の属性数がかなり変わるので、見せない人には見せない属性の存在も知らせたくない、
といったこともあり、パターンを網羅した固定サブフォームは作り難いという背景もありました。
なな、なんと。そんなやり方ありましたか。
確認させていただきます。
ですよね。
フォームウィザードでデータシートビューで作成すれば１分もかからずに作成できますからね。
現状のロジックも参照先を変更するだけでそのまま使えるはずですし。
あー、なるほど、そういう仕組みありましたねぇ。使わないとパッと出てこないです
サブフォームを作る労力とどのくらい差があるかなぁとも思っていしまいますし