フォーム内のタブコントロールをExcelに抽出したい

2020/09/04 00:36

タブコントロール内の情報と同じ内容をクエリーで抽出は出来ないのですか？また出来ないとしたら、その理由は？

2020/09/04 23:55

コードはマークダウン記法のコードブロック内にいれてください。コードを選択した状態で、ツールバーの <code> をクリックすればコードブロックになります。

2020/09/05 00:12

> どうしてもタブコントロール内にある別テーブルを元にしたサブフォームやテキストボックスの情報をExcelに抽出できず困っています。この部分のコードを提示してください。

2020/09/08 00:58

sazi様返事が遅くなり申し訳ありません。クエリで抽出したものをレコードソースにするのでしょうか？

2020/09/08 01:14

回答しました。

行動規範の内容に同意します

回答2件

そのフォームのレコードソースをクエリーとして保存したものをDoCmd.TransferSpreadsheetを使用してエクセル出力する方が簡単ではないかと思います。
データをExcelファイルにエクスポートする

VBA
1DoCmd.TransferSpreadsheet acExport, , "[レコードソース同等のクエリー]", "ファイルのフルパス"

投稿2020/09/08 01:13

総合スコア25327

2020/09/08 02:19

今それぞれのタブにあるテーブルを1つのクエリにまとめてそのクエリをレコードソースにしてみたのですが、いろいろとエラーが出てきてしまいました・・・。タブコントロール内にあるサブフォームのテーブルに重複するものがありそれがメインフォームに表示されてしまいます・・・また、メインフォームに解約者も表示するかどうかのチェックボックスを置いてあり、それもうまく作動しなくなりました。そのためクエリを作ってそれをレコードソースにするという手法は少しややこしくなってしまったので今回はやめておこうと思います・・・初めから1つのクエリにまとめて作ればよかったものの後々のことを考えずに進めてしまった証拠ですね・・・せっかく回答を頂いたのに申し訳ありませんでした。

サブフォームとサブフォームコントロールの違いとは？ - hatena chips

2020/09/08 02:35

エクセルに出力する為のクエリーを無理にレコードソースにする必要はありません。現状のレコードソースを元に新たにエクセル出力用のクエリーを作れば良いのです。

行動規範の内容に同意します

ベストアンサー

提示の ExcelData を使って下記のコードで可能です。

メインフォーム上のコマンドボタンの名前を「コマンド1」
サブフォームを埋め込んでいるサブフォームコントロー名を「埋め込み1」
として、

vba
1Private Sub コマンド1_Click()
2    Call ExcelData(Me.埋め込み1.Form)
3End Sub

サブフォーム名とサブフォームコントロール名は別物ということは認識してますか。
わからなければ、下記のリンク先を参考にしてください。

複数のサブフォームのデータを一つのブックに連続して追加する場合

標準モジュール

vba
1'Excelにデータを出力
2'引数
3' frm: フォームオブジェクト(省略不可)
4' wlb: 既に開いているワークブック(省略可)
5'      省略した場合はワークブックを新規作成する
6' 既に開いているワークブックに追加するときは、データのフィールドは同一とする
7Function ExcelData(frm As Form, Optional wkb As Object) As Object
8    On Error GoTo Err_Excelcmd_Click
9
10    'DAOで抽出結果のクローンを作成
11    Dim xls As Object 'Excel.Applicationを代入するオブジェクト変数
12'    Dim wkb As Object 'Excel.Wookbookを代入するオブジェクト変数
13    Dim rst As DAO.Recordset '現在のレコードセットを入れる変数
14    Dim idx As Long  'フィールド数変数
15
16    Set rst = frm.Recordset.Clone  'フォームのレコードセットのクローンを代入
17
18    'レコードが存在しない場合、処理を中止
19    If rst.BOF = True And rst.EOF = True Then
20        MsgBox "出力出来るデータがありません。", vbOKOnly + vbExclamation, "出力不可"
21        'レコードセットを閉じる
22        rst.Close: Set rst = Nothing
23        Exit Function
24    End If
25
26    'レコードが存在する場合、Excelに出力
27    'レコードセットの最初のデータにカーソルを移動
28    rst.MoveFirst
29    
30    If wkb Is Nothing Then 'ワークブックが指定されていないとき
31        'Excelファイルを内部的に作成
32        Set xls = CreateObject("Excel.Application")
33        '作成されたExcelファイルにワークブックを追加
34        Set wkb = xls.Workbooks.Add()
35    Else
36        Set xls = wkb.Application
37    End If
38    
39    'ワークブックに、レコードセットのデータをコピー
40    With wkb.Worksheets(1)
41        If .Range("A1") = "" Then
42            For idx = 1 To rst.Fields.Count
43                .Cells(1, idx).Value = rst.Fields(idx - 1).Name
44            Next
45        End If
46        Dim LastRow As Long
47        LastRow = .Range("A1").CurrentRegion.Rows.Count
48        .Cells(LastRow + 1, 1).CopyFromRecordset Data:=rst
49    End With
50
51    'レコードセットを閉じる
52    rst.Close: Set rst = Nothing
53    'Excelデータを表示
54    xls.Visible = True
55    xls.UserControl = True
56    'メモリに展開されたExcel用オブジェクト変数を開放
57    Set ExcelData = wkb
58    
59    Set wkb = Nothing
60    Set xls = Nothing
61
62Exit_Excelcmd_Click:
63    Exit Function
64
65Err_Excelcmd_Click:
66    'エラーの場合、エラーNOと内容を表示
67'    MsgBox Err.Number & Err.Description
68    MsgBox "エラーのため、Excelへ出力できません。" & vbCrLf & "一旦フォームを閉じ、再度トライしてください。", _
69    vbOKOnly + vbCritical, "Excel出力不可！"
70    Resume Exit_Excelcmd_Click
71End Function

フォームのモジュール

vba
1Private Sub コマンド1_Click()
2    Dim wkb As Object
3    
4    Set wkb = ExcelData(Me.埋め込み1.Form)
5    Set wkb = ExcelData(Me.埋め込み2.Form, wkb)
6    Set wkb = ExcelData(Me.埋め込み3.Form, wkb)
7    Set wkb = ExcelData(Me.埋め込み4.Form, wkb)  
8  
9    Set wkb = Nothing
10End Sub

投稿2020/09/05 00:23

編集2020/09/08 05:22

総合スコア34075

2020/09/08 00:49

返事が遅くなり申し訳ございません。質問を追記したので宜しくお願い致します。

2020/09/08 01:36

それはタブコントロールの名前ですね。「選択の種類:タブコントロール」となってますよね。回答に参考リンクを追加しましたので、それを参考にしてください。

2020/09/08 02:06

タブ丸ごとExcelに抽出するのはできないのですね・・・タブ内にあるサブフォームごとにコードを作ればいいのでしょうか。タブが4つあれば Private Sub コマンド1_Click() Call ExcelData(Me.埋め込み1.Form) Call ExcelData(Me.埋め込み2.Form) Call ExcelData(Me.埋め込み3.Form) Call ExcelData(Me.埋め込み4.Form) End Sub 上記のようなコードで大丈夫ですか？

2020/09/08 02:37

そうなりますね。ただ、そのコードだとそれぞれ別のブックに書き込まれることになるので、同じブックにということなら、ExcelDataのコードを修正する必要はあります。

2020/09/08 04:01

よろしければ同じブックに書き込めるコードを教えて頂けますでしょうか。

2020/09/08 05:19

回答に追記しましたので、参考にしてください。

2020/09/09 00:06

回答ありがとうございます。記入してみたところ型が一致しませんと出てしまいます・・・そして同時にExcelも立ち上がるのですがExcelにあるデータは Set wkb = ExcelData(Me.埋め込み1.Form) 上記で指定したデータだけでした。恐らく上記コードより下がダメみたいです・・・解決策はありますでしょうか。

2020/09/09 02:52

簡単なサンプルを作成して動作確認済みですので、どこか間違えているのでしょう。回答のコードと見比べて違いがないか確認してください。「型が一致しません」とエラーがでるのはどのコードですか。それを提示してください。