ACCESSからExcel操作のVBAは初めてで躓いております。どうかよろしくお願い致します。
◆やりたいこと
ACCESSのフォームからチェックボックスで選択した取引先データをCopyFromRecordsetで書き出し、横長のクエリを切り分けExcel上で見やすい帳票に加工したい
◆できていること
選択した取引先のデータを、任意のセルにフィールド名やクエリの内容を書き出せている
◆困っていること
都度、選択する取引先が違うため、For~Nextで繰り返し処理を行おうとしている。その際に処理が終わったExcelBookは任意の名前を付けて保存し、次の処理に進みたいと考えております。
しかし、『名前を付けて保存』でエラ-438(オブジェクトサポートなし)が表示されます。色々なサイトを見てみるのですがうまくいきません。
初心者のため根本的なミスかもしれませんがご教示いただきますようお願い致します。
Private
1 2Dim RS1 As Recordset, RS2 As Recordset 3Dim RR As Integer 'ROW 4Dim CC As Integer 'Cell 5Dim EE As Object 'Excel 6Dim i As Integer 7Dim idx1 As Integer, idx2 As Integer 8Dim CNT1 As Integer, CNT2 As Integer 9Dim Q_N As String '会社名 10 11 12 13 Set DB = CurrentDb() 14 15 For idx1 = 1 To 21 16 17 If Me("CHK_" & idx1) = True Then 18 Set RS1 = DB.OpenRecordset("SELECT M_仕入先会社マスタ.* FROM M_仕入先会社マスタ WHERE ((ID=" & idx1 & "));") 19 RS1.Edit 20 RS1!CHK = Me("CHK_" & idx1) 21 RS1.Update 22 End If 23 24 Next 25 26 Set RS1 = DB.OpenRecordset("SELECT M_仕入先会社マスタ.仕入先コード FROM M_仕入先会社マスタ WHERE (((M_仕入先会社マスタ.[CHK])=-1));") 27 28 CNT1 = 0 29 CNT2 = 0 30 31 Do Until RS1.EOF 32 33 Set EE = CreateObject("Excel.Application") 34 '本番はfalse 35 EE.Visible = True 36 37 With EE 38 .ScreenUpdating = True 39 .Workbooks.Add 40 End With 41 42 For idx2 = 1 To 4 43 44 45 Set RS2 = DB.OpenRecordset("SELECT Q_シミュレート_" & idx2 & ".* FROM Q_シミュレート_" & idx2 & " WHERE (((Q_シミュレート_" & idx2 & ".仕入先コード)='" & RS1!仕入先コード & "'));") 46 47 Q_N = RS2!会社名 48 49 If idx2 = 1 Then 50 CNT1 = DCount("*", "Q_シミュレート_" & idx2 & "", "仕入先コード = '" & RS2!仕入先コード & "'") 51 'フィールド名の書き出し 52 For i = 0 To RS2.Fields.Count - 1 53 ActiveSheet.Cells(1, i + 1).Value = RS2.Fields(i).Name 54 Next i 55 'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し 56 ActiveSheet.Range("A2").CopyFromRecordset RS2 57 58 CNT1 = CNT1 + 2 59 CNT2 = CNT1 60 61 Else 62 63 For i = 0 To RS2.Fields.Count - 1 64 ActiveSheet.Cells(CNT2 + 1, i + 1).Value = RS2.Fields(i).Name 65 Next i 66 'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し 67 ActiveSheet.Range("A" & CNT2 + 2).CopyFromRecordset RS2 68 69 CNT2 = CNT2 + CNT1 70 71 End If 72 73 Next 74'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 75↓ここからが失敗箇所です 76 With EE 77 .Save 78 EE.SaveAs "J:\シミュレート表_2018\" & Q_N & ".xlsx" 79 EE.Quit 'Excel終了 80 Set EE = Nothing '参照開放 81 End With 82 Loop 83End Sub
回答2件
あなたの回答
tips
プレビュー