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 フィールドは常に表示
コンボボックスで選択されたフィールドが表示
では、以下[社員コード]と読み替えます。
単純に「[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()" ←------この場所で入れてもダメですか？
上記の動的に変えているところを削除すると、イベントが発生することは画にしました。
人により、列の属性数がかなり変わるので、見せない人には見せない属性の存在も知らせたくない、
といったこともあり、パターンを網羅した固定サブフォームは作り難いという背景もありました。
なな、なんと。そんなやり方ありましたか。
確認させていただきます。
ですよね。
フォームウィザードでデータシートビューで作成すれば１分もかからずに作成できますからね。
現状のロジックも参照先を変更するだけでそのまま使えるはずですし。
あー、なるほど、そういう仕組みありましたねぇ。使わないとパッと出てこないです
サブフォームを作る労力とどのくらい差があるかなぁとも思っていしまいますし
そういうことでしたか。
ソースオブジェクトにテーブルやクエリを設定した場合、メインフォームを開いたときに自動でサブフォームオブジェクトが生成されますので、それにイベントを設定することができます。
Accessのフォームの場合、イベントプロパティにFunctionを設定できますので、それを利用すればご希望のことは実現可能です。
まず、標準モジュールに下記のFunctionを記述してください。
CodeContextObject はFunctionが呼び出されたオブジェクトを返します。
メインフォームの読み込み時イベントに下記のコードを設定してください。
クエリにはIDフィールドがあり、メインフォームには「テキスト1」というテキストボックスがあるという前提です。
メインフォームを開いてサブフォームでレコード移動してみてください。
イベントが発生しているのが確認できるでしょう。
hatenaさん ありがとうございます。
確かにSQLの文法と、VBAの文法がごっちゃになってました。それを意識しながら進めます。多分ＤＡＯが何なのかが理解できてないのですね。色々勉強していきます。自分のコードが妥当なのかどうか自信ない事が多いので・・・
今回も大変お世話になりました。
なるほどです、クリック時のイベントでフラグを立てるというのは思ってもいませんでした。
貴重な情報、ありがとうございます。
はやりそうですよね、当初の理解通りではありました。
現状、ボタンクリック時に呼び込みはできているので、
このためだめにサブフォームを作って、ロジックも変えないといけない工数が大きいので、
暫くは様子をみます。
なるほど、把握しました
ソースオブジェクトにフォームを指定しない場合は、明示的にイベントを発生させることができないので基本的には無理ですね
なるほどです。すみません、説明不足でした。
サブフォームコントロールのソースオブジェクトは、サブフォームではなく、
クエリ（データシート）を設定しています。
サブフォームは作っていなくて、そもそもこれを作って設定すれば、
カレントのイベントが取れるというのは、冒頭でもお話した通り、理解はしております。
サブフォームコントロールにクエリ（データシート）を設定した場合、
代替案はないでしょうか？というのが冒頭での質問の本意です。
サブフォームコントロールにはサブフォームが埋め込まれているので、そのサブフォームのイベントに設定すればご希望のことは可能です。
サブフォームに設定したレコード移動イベントは、メインフォームを開いてサブフォームでレコード移動させれば発生します。
まずはやってみてうまくいかないなら、どのようにしたのか、記述したコード、どのようにうまくいかないのか説明してください。