teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問AccessVBAから、「開いているExcelブック/シートを1つにまとめて保存」という処理を行いたい

編集履歴

回答編集履歴

5

コード修正

2021/01/11 16:21

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -192,7 +192,7 @@
192
192
 
193
193
  'ブックを閉じる場合は、最後のブックから閉じていかないとうまくいかない
194
194
 
195
- For i = xlsx.Workbooks(xlsx.Workbooks.Count) To 2 Step 1
195
+ For i = xlsx.Workbooks.Count To 2 Step 1
196
196
 
197
197
  xlsx.Workbooks(i).Worksheets(1).Copy _
198
198
 

4

コード修正

2021/01/11 16:20

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -172,33 +172,35 @@
172
172
 
173
173
 
174
174
 
175
- Dim DesktopPath As String, FilePath As String, WSH As Variant
175
+ Dim DesktopPath As String, FilePath As String, WSH As Variant
176
-
176
+
177
- Set WSH = CreateObject("Wscript.Shell")
177
+ Set WSH = CreateObject("Wscript.Shell")
178
-
178
+
179
- DesktopPath = WSH.SpecialFolders("Desktop")
179
+ DesktopPath = WSH.SpecialFolders("Desktop")
180
-
180
+
181
- FilePath = DesktopPath & "\保存名.xlsx"
181
+ FilePath = DesktopPath & "\保存名.xlsx"
182
-
183
-
184
-
182
+
183
+
184
+
185
- 'メイン処理
185
+ 'メイン処理
186
-
186
+
187
- Dim i As Integer
187
+ Dim i As Integer
188
188
 
189
189
 
190
190
 
191
191
  '開いているExcelブック数を数えて、２個目以降のブックのSheets(1)を1個目のブックに追加して閉じていく
192
192
 
193
+ 'ブックを閉じる場合は、最後のブックから閉じていかないとうまくいかない
194
+
193
- For i = 2 to xlsx .Workbooks(xlsx.Workbooks.Count)
195
+ For i = xlsx.Workbooks(xlsx.Workbooks.Count) To 2 Step 1
194
-
196
+
195
- xlsx .Workbooks(i).Worksheets(1).copy _
197
+ xlsx.Workbooks(i).Worksheets(1).Copy _
196
-
198
+
197
- Before:=xlsx.Workbooks(1).Sheets(1) 'ワークブック1にシートを追加してコピー
199
+ Before:=xlsx.Workbooks(1).Sheets(1) 'ワークブック1にシートを追加してコピー
198
-
200
+
199
- xlsx.Workbooks(i).Close
201
+ xlsx.Workbooks(i).Close
200
-
202
+
201
- next i
203
+ Next i
202
204
 
203
205
 
204
206
 
@@ -208,7 +210,7 @@
208
210
 
209
211
 
210
212
 
211
- MsgBox "完了しました。"
213
+ MsgBox "完了しました。"
212
214
 
213
215
 
214
216
 

3

説明追記

2021/01/11 09:37

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -231,3 +231,7 @@
231
231
  Set xlsx = NoThing
232
232
 
233
233
  ```
234
+
235
+
236
+
237
+ 「AccessVBAでExcelブックを1つにまとめて保存」プロシージャでブックを保存してますので、その最後でExcelアプリケーションを終了、解放してもいいかもです。

2

コード追記

2021/01/11 09:16

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -156,6 +156,64 @@
156
156
 
157
157
  End Function
158
158
 
159
+
160
+
161
+ Sub AccessVBAでExcelブックを1つにまとめて保存()
162
+
163
+
164
+
165
+ If xlsx Is Nothing Then
166
+
167
+ MsgBox "開いているブックはありません。"
168
+
169
+ Exit Sub
170
+
171
+ End If
172
+
173
+
174
+
175
+ Dim DesktopPath As String, FilePath As String, WSH As Variant
176
+
177
+ Set WSH = CreateObject("Wscript.Shell")
178
+
179
+ DesktopPath = WSH.SpecialFolders("Desktop")
180
+
181
+ FilePath = DesktopPath & "\保存名.xlsx"
182
+
183
+
184
+
185
+ 'メイン処理
186
+
187
+ Dim i As Integer
188
+
189
+
190
+
191
+ '開いているExcelブック数を数えて、２個目以降のブックのSheets(1)を1個目のブックに追加して閉じていく
192
+
193
+ For i = 2 to xlsx .Workbooks(xlsx.Workbooks.Count)
194
+
195
+ xlsx .Workbooks(i).Worksheets(1).copy _
196
+
197
+ Before:=xlsx.Workbooks(1).Sheets(1) 'ワークブック1にシートを追加してコピー
198
+
199
+ xlsx.Workbooks(i).Close
200
+
201
+ next i
202
+
203
+
204
+
205
+ xlsx.Workbooks(1).SaveAs FileName:=FilePath
206
+
207
+ xlsx.Workbooks(1).Close
208
+
209
+
210
+
211
+ MsgBox "完了しました。"
212
+
213
+
214
+
215
+ End Sub
216
+
159
217
  ```
160
218
 
161
219
 

1

説明追記

2021/01/11 08:12

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -41,3 +41,135 @@
41
41
 
42
42
 
43
43
  その辺を明確に提示してください。
44
+
45
+
46
+
47
+ 追記されたコードについて
48
+
49
+ ---
50
+
51
+
52
+
53
+ CreateObject("Excel.Application")は新規のエクセルアプリケーションを生成します。
54
+
55
+ もし、これを繰り返す実行すると複数のエクセルアプリケーションが開いてしまいます。
56
+
57
+ （タスクマネージャーで確認してみてください。）
58
+
59
+ それぞれのWorkbooks.Add()で新規ブックを一つ開いていることになります。
60
+
61
+
62
+
63
+ 下記の点を考慮してコーディングしてください。
64
+
65
+
66
+
67
+ - Dim xlsx As Object の宣言は標準モジュールの冒頭で宣言する。モジュールの冒頭だとモジュールの実行後自動解放されるので以降参照できない。また、モジュール内で解放しないようにする。
68
+
69
+ - CreateObject("Excel.Application")は最初の一回のみ実行する。複数のエクセルアプリケーションを開かないようにする。
70
+
71
+
72
+
73
+ 上記を考慮すると、
74
+
75
+
76
+
77
+ ```vba
78
+
79
+ Option Compare Database
80
+
81
+ Option Explicit
82
+
83
+
84
+
85
+ Dim xlsx As Object 'Excel.Applicationを代入するオブジェクト変数
86
+
87
+
88
+
89
+ Function ExcelData(frm As Form)
90
+
91
+ On Error GoTo Err_cmdExcel_Click
92
+
93
+ 'DAOで抽出結果のクローンを作成
94
+
95
+ Dim wkb As Object 'Excel.Wookbookを代入するオブジェクト変数
96
+
97
+ Dim rst As DAO.Recordset '現在のレコードセットを入れる変数
98
+
99
+ Dim idx As Long 'フィールド数変数
100
+
101
+ Dim j As Long ' 最終行取得用
102
+
103
+ Const xlUp As Integer = -4162
104
+
105
+
106
+
107
+ '****中略*****
108
+
109
+
110
+
111
+ 'Excelアプリケーションを生成(事前に生成されていない場合のみ)
112
+
113
+ If xlsx Is Nothing Then
114
+
115
+ Set xlsx = CreateObject("Excel.Application")
116
+
117
+ End If
118
+
119
+
120
+
121
+ 'Excelアプリケーションにワークブックを追加
122
+
123
+ Set wkb = xlsx.Workbooks.Add()
124
+
125
+
126
+
127
+ '追加されたワークブックに、レコードセットのデータをコピー
128
+
129
+ With wkb.Worksheets(1)
130
+
131
+
132
+
133
+ '****中略*****
134
+
135
+
136
+
137
+ 'Excelデータを表示
138
+
139
+ xlsx.Visible = True
140
+
141
+ xlsx.UserControl = True
142
+
143
+ 'メモリに展開されたExcel用オブジェクト変数は解放しない
144
+
145
+ 'Set wkb = Nothing
146
+
147
+ 'Set xlsx = Nothing
148
+
149
+ End With
150
+
151
+
152
+
153
+ '****中略*****
154
+
155
+
156
+
157
+ End Function
158
+
159
+ ```
160
+
161
+
162
+
163
+ 生成したExcelアプリケーションは、適切なタイミングで、終了、解放しておく必要があります。
164
+
165
+ 不必要になった時とか、Accessを閉じる前とか、・・・
166
+
167
+
168
+
169
+ ```vba
170
+
171
+ xlsx.Quit
172
+
173
+ Set xlsx = NoThing
174
+
175
+ ```