Accessで煮詰まってしまいました。

Question

▼作成したいツール▼

①Microsoft Accessにデータを入力
②そのデータをexcelで作られたテンプレートの複数のセルに貼り付け
③テンプレートのExcelを印刷する

以上のツールを作成しておりました。
①の入力後、レコード1行ごとに1枚のテンプレートを作成し、1枚ずつ印刷する流れです。

▼現状▼

テンプレートには項目ごとに入力する欄と、請求書のような表になっている部分がありました。

クエリを作成し、レコードごとに各項目を対応するセルへ貼り付け、それを印刷という流れを単純にループさせるVBAを作成しました。

▼課題▼

無事にそこまでは成功したのですが、追加の依頼があり、同じ電話番号の案件については同じテンプレートの表に入力してほしいとのことでした。

例えばですが、
03-1111-2222 山田さん
03-1111-2222 高橋さん
03-2222-3333 布施さん
03-1111-2222 長谷川さん

とレコードが並んでいた時に、
1レコードずつであれば4枚のテンプレートが作成されますが、

作成したいのは2枚のテンプレートが印刷されるようにしたいと考えております。
ここでは、下4桁2222の山田さん、高橋さん、長谷川さんと入力された一枚と、下4桁3333の布施さんの書かれた2枚です。

本日急に依頼がありAccessを取り扱うのが久しぶりのため、困惑している状況です。
申し訳ございませんが、お力添え頂けたら嬉しいです。

質問頂きありがとうございます。
本日出先のため、すぐにコードを掲載出来ず申し訳ございません。

https://tsware.jp/tips/tips_689.htm

こちらのサイトのコードをベースに作成しておりました。
こちらで動作はしたのですが、このままでは電話番号が同じだとしても、1レコードごとに1枚用紙が印刷されてしまいます。
何かしらの方法を考えたのですが、思い付きませんでした。

クエリは日付、担当者名、電話番号、対応要否の簡単なもので、テーブルで対応要否にチェックが入っているものを抽出していました。

テンプレートの表でない部分に日付、表の部分には担当者名と電話番号が入ります。
同じ電話番号であれば、同じテンプレート内の表に担当者名、電話番号を入れたいと考えております。

分かりづらい文章で申し訳ないのですが、不明点がございましたら再度お知らせ頂けたらありがたいです。

Comments

[hatena19]

現状のクエリやVBAのコードを提示してください。

[sakam112]

ありがとうございます、追記致しました。

[K_3578]

どうでも良いんですけど「煮詰まる」は「論議が十分に行われて結論が出せるようになった状況」という
意味なので正しくは「行き詰まる」です

Answer 1

まず、顧客台帳というテーブルにデータを入れます。
SQLで電話番号をグループ化すると電話番号が２つにまとめられます。
次のSQLで電話番号を基に検索すれば、03-1111-2222で３件、03-2222-3333で１件のデータを呼び出すことができます。
Excelを開く処理、Excelに書き込む処理は既にできていると思いましたので省きました。

Dim DB  As Database
Dim TB1   As Recordset
Dim TB2  As Recordset
Dim SQL As String
Dim Count As Integer

    Set DB = CurrentDb
    SQL = ""
    SQL = SQL & "SELECT 顧客台帳.電話番号 "
    SQL = SQL & "FROM 顧客台帳 "
    SQL = SQL & "GROUP BY 顧客台帳.電話番号"
    Set TB1 = DB.OpenRecordset(SQL, dbOpenDynaset)
    If TB1.EOF = False Then
        Do While TB1.EOF = False
            'Excelを開く処理を追加する
            Count = 1
            SQL = ""
            SQL = SQL & "SELECT 顧客台帳.* "
            SQL = SQL & "FROM 顧客台帳 "
            SQL = SQL & "WHERE (顧客台帳.電話番号 = '" & TB1!電話番号 & "')"
            Set TB2 = DB.OpenRecordset(SQL, dbOpenDynaset)
            If TB2.EOF = False Then
                Do While TB2.EOF = False
                    'セルに書き込む処理を追加
                    Count = Count + 1
                    TB2.MoveNext
                Loop
            End If
            TB2.Close
            'Excelを名前を付けて保存する処理を追加する
            TB1.MoveNext
        Loop
    End If
    TB1.Close
    DB.Close
    Set TB1 = Nothing
    Set TB2 = Nothing
    Set DB = Nothing