teratail header banner
teratail header banner
質問するログイン新規登録

質問編集履歴

2

修正

2021/01/11 06:32

投稿

NGK
NGK

スコア1

title CHANGED
File without changes
body CHANGED
@@ -42,6 +42,7 @@
42
42
  追記:2021/01/11 15:30
43
43
  事前にエクセルを開いているコードはこちらです。
44
44
  標準モジュールに書いた以下のコードを、フォームのクリック時イベントで複数回よびだしてExcelブックを開いています。
45
+ ```ここに言語を入力
45
46
 
46
47
  Function ExcelData(frm As Form)
47
48
  On Error GoTo Err_cmdExcel_Click
@@ -98,4 +99,5 @@
98
99
  MsgBox "エラーのため、Excelへ出力できません。" & vbCrLf & "一旦フォームを閉じ、再度トライしてください。" & vbCrLf & Err.Number & Err.Description, _
99
100
  vbOKOnly + vbCritical, "Excel出力不可!"
100
101
  Resume Exit_cmdExcel_Click
101
- End Function
102
+ End Function
103
+ ```

1

追加

2021/01/11 06:32

投稿

NGK
NGK

スコア1

title CHANGED
File without changes
body CHANGED
@@ -37,4 +37,65 @@
37
37
  MsgBox "完了しました。"
38
38
 
39
39
  End Sub
40
- ```
40
+ ```
41
+
42
+ 追記:2021/01/11 15:30
43
+ 事前にエクセルを開いているコードはこちらです。
44
+ 標準モジュールに書いた以下のコードを、フォームのクリック時イベントで複数回よびだしてExcelブックを開いています。
45
+
46
+ Function ExcelData(frm As Form)
47
+ On Error GoTo Err_cmdExcel_Click
48
+ 'DAOで抽出結果のクローンを作成
49
+ Dim xlsx As Object 'Excel.Applicationを代入するオブジェクト変数
50
+ Dim wkb As Object 'Excel.Wookbookを代入するオブジェクト変数
51
+ Dim rst As DAO.Recordset '現在のレコードセットを入れる変数
52
+ Dim idx As Long 'フィールド数変数
53
+ Dim j As Long ' 最終行取得用
54
+ Const xlUp As Integer = -4162
55
+
56
+ Set rst = Nothing 'データリストの初期化
57
+ Set rst = frm.RecordsetClone 'フォームのレコードセットのクローンを代入
58
+
59
+ 'レコードが存在しない場合、処理を中止
60
+ If rst.BOF = True And rst.EOF = True Then
61
+ MsgBox "出力出来るデータがありません。", vbOKOnly + vbExclamation, "出力不可"
62
+ 'レコードセットを閉じる
63
+ rst.Close: Set rst = Nothing
64
+ Exit Function
65
+ End If
66
+
67
+ 'レコードが存在する場合、Excelに出力
68
+ 'レコードセットの最初のデータにカーソルを移動
69
+ rst.MoveFirst
70
+
71
+ 'Excelファイルを内部的に作成
72
+ Set xlsx = CreateObject("Excel.Application")
73
+ '作成されたExcelファイルにワークブックを追加
74
+ Set wkb = xlsx.Workbooks.Add()
75
+
76
+ '追加されたワークブックに、レコードセットのデータをコピー
77
+ With wkb.Worksheets(1)
78
+
79
+ For idx = 1 To rst.Fields.Count
80
+ .cells(1, idx).Value = rst.Fields(idx - 1).Name
81
+ Next
82
+
83
+ .Range("A2").CopyFromRecordset Data:=rst
84
+
85
+ 'レコードセットを閉じる
86
+ rst.Close: Set rst = Nothing
87
+ 'Excelデータを表示
88
+ xlsx.Visible = True
89
+ xlsx.UserControl = True
90
+ 'メモリに展開されたExcel用オブジェクト変数を開放
91
+ Set wkb = Nothing
92
+ Set xlsx = Nothing
93
+
94
+ Exit_cmdExcel_Click:
95
+ Exit Function
96
+
97
+ Err_cmdExcel_Click:
98
+ MsgBox "エラーのため、Excelへ出力できません。" & vbCrLf & "一旦フォームを閉じ、再度トライしてください。" & vbCrLf & Err.Number & Err.Description, _
99
+ vbOKOnly + vbCritical, "Excel出力不可!"
100
+ Resume Exit_cmdExcel_Click
101
+ End Function