質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.35%

  • VBA

    1899questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1624questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • Access

    469questions

    Accessはマイクロソフトによるリレーショナルデータベース管理システムです。オブジェクト指向のアプリケーション作成に対応しており、テーブルや編集をはじめ、クエリ生成、入力フォーム作成、レポート作成など一通りの機能を備えています。

ACCESSからのExcel操作について

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 481

napoleon

score 12

ACCESSからExcel操作のVBAは初めてで躓いております。どうかよろしくお願い致します。

◆やりたいこと
ACCESSのフォームからチェックボックスで選択した取引先データをCopyFromRecordsetで書き出し、横長のクエリを切り分けExcel上で見やすい帳票に加工したい

◆できていること
選択した取引先のデータを、任意のセルにフィールド名やクエリの内容を書き出せている

◆困っていること
都度、選択する取引先が違うため、For~Nextで繰り返し処理を行おうとしている。その際に処理が終わったExcelBookは任意の名前を付けて保存し、次の処理に進みたいと考えております。
しかし、『名前を付けて保存』でエラ-438(オブジェクトサポートなし)が表示されます。色々なサイトを見てみるのですがうまくいきません。

初心者のため根本的なミスかもしれませんがご教示いただきますようお願い致します。

Dim RS1 As Recordset, RS2 As Recordset
Dim RR As Integer 'ROW
Dim CC As Integer 'Cell
Dim EE As Object 'Excel
Dim i As Integer
Dim idx1 As Integer, idx2 As Integer
Dim CNT1 As Integer, CNT2 As Integer
Dim Q_N As String  '会社名



    Set DB = CurrentDb()

        For idx1 = 1 To 21

            If Me("CHK_" & idx1) = True Then
                Set RS1 = DB.OpenRecordset("SELECT M_仕入先会社マスタ.* FROM M_仕入先会社マスタ WHERE ((ID=" & idx1 & "));")
                RS1.Edit
                RS1!CHK = Me("CHK_" & idx1)
                RS1.Update
            End If

        Next

        Set RS1 = DB.OpenRecordset("SELECT M_仕入先会社マスタ.仕入先コード FROM M_仕入先会社マスタ WHERE (((M_仕入先会社マスタ.[CHK])=-1));")

        CNT1 = 0
        CNT2 = 0

        Do Until RS1.EOF

            Set EE = CreateObject("Excel.Application")
            '本番はfalse
            EE.Visible = True

            With EE
                .ScreenUpdating = True
                .Workbooks.Add
            End With

            For idx2 = 1 To 4


                Set RS2 = DB.OpenRecordset("SELECT Q_シミュレート_" & idx2 & ".* FROM Q_シミュレート_" & idx2 & " WHERE (((Q_シミュレート_" & idx2 & ".仕入先コード)='" & RS1!仕入先コード & "'));")

                Q_N = RS2!会社名

                If idx2 = 1 Then
                    CNT1 = DCount("*", "Q_シミュレート_" & idx2 & "", "仕入先コード = '" & RS2!仕入先コード & "'")
                    'フィールド名の書き出し
                    For i = 0 To RS2.Fields.Count - 1
                    ActiveSheet.Cells(1, i + 1).Value = RS2.Fields(i).Name
                    Next i
                    'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し
                    ActiveSheet.Range("A2").CopyFromRecordset RS2

                    CNT1 = CNT1 + 2
                    CNT2 = CNT1

                Else

                    For i = 0 To RS2.Fields.Count - 1
                    ActiveSheet.Cells(CNT2 + 1, i + 1).Value = RS2.Fields(i).Name
                    Next i
                    'CopyFromRecordsetメソッドで基準セルを指定してデータの書き出し
                    ActiveSheet.Range("A" & CNT2 + 2).CopyFromRecordset RS2

                    CNT2 = CNT2 + CNT1

                End If

            Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
↓ここからが失敗箇所です
            With EE
                   .Save
                    EE.SaveAs "J:\シミュレート表_2018\" & Q_N & ".xlsx"
                    EE.Quit 'Excel終了
                    Set EE = Nothing '参照開放
            End With
        Loop
End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • mts10806

    2018/06/27 14:42

    質問編集画面タイトル横にある「初心者アイコン」をご活用ください。「初心者」と質問で書くよりも伝わりますし、質問一覧に表示されるのでわかりやすくなります。

    キャンセル

  • napoleon

    2018/06/27 14:52

    ご指摘ありがとうございます。今後使用させていただきます。

    キャンセル

回答 2

+1

workbookのsaveになってないのでは?

With EE
 .ScreenUpdating = True
 .Workbooks.Add
End With


Dim wbTmp As Workbook
With EE
 .ScreenUpdating = True
 .Workbooks.Add
  Set wbTmp = ActiveWorkbook
End With


とかしておいて、SaveのときにwbTmp.Saveとしては?

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/27 15:48

    回答ありがとうございます。
    今まで実行時エラーは438だったのですが、今度は実行時エラー91が出るようになりました。
    『SaveのときにwbTmp.Saveとしては? 』というのは実際にどのような記述になるのでしょうか?
    無学で申し訳ありません。

    キャンセル

  • 2018/06/27 16:07

    EE.SaveもしくはEE.SaveAsの代わりにwbTmp.Saveしては?
    という意味でした。
    質問のコードに揃えるなら、
    SaveAs "J:\シミュレート表_2018\" & Q_N & ".xlsx"
    でしょうか。

    SaveメソッドはExcel.Applicationオブジェクトではなく、Workbookオブジェクトのメソッドだと思いますので。
    https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/workbook-saveas-method-excel

    そもそもループの中でExcel.Applicationを起こして落としてしているのも悪影響ありそうなので、ループの外に出してループの中ではWorkbookの作成、クローズにした方がよいとも思いますよ。(レコードセットの1行ごとにやってるので、同じファイル名(=取引先)をたくさん作ろうとすることによるエラーも起きそうな気がしますが)

    キャンセル

  • 2018/06/27 16:19

    回答ありがとうございます。なんとか保存が出来ました。やはりループの中でやるのは危険ですか。。。
    一旦取引先のExcelを作成しクローズした後に、再度立ち上げて製表する方が効率が良いのでしょうか?
    ここから条件付き書式などを設定していこうとしています。
    理想としてはACCESSでExportボタンを押せばエクセルが製表されて任意のフォルダに格納されるというのが理想なのですが。。。(職場のおぢ様達がみたいというリクエストに応えるべく。。。)

    キャンセル

  • 2018/06/27 16:27

    ヒントだけですが、ループの度に個々のファイルでCloseすることをやめて、
    https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/workbook-save-method-excel
    にある、「開かれているすべてのブックを保存して Excel を終了」のコードを参考に「任意のフォルダ」を指定するコードを組み込めば、ループが終わった時にディレクトリの指定を1回だけで保存させることはできますね。

    ただ、その場合Workbookはすべて開きっぱなしになるので、ActiveWorkbookやActiveSheetがどこにあるのか把握しながらコードを書かないと上手く行かなくなりますので、ご注意を。

    キャンセル

  • 2018/06/27 16:30

    ForEachを使うのですね
    あまり使ったことがないですがヒントをもとに挑戦してみようと思います。
    ありがとうございました。

    キャンセル

  • 2018/06/27 17:38

    worksheetの変数を宣言してやってみたらうまく行きました。お騒がせ致しました。

    キャンセル

checkベストアンサー

0

            With EE
                .ScreenUpdating = True
                .Workbooks.Add
            End With
            '中略
            With EE
                   .Save 
                    EE.SaveAs "J:\シミュレート表_2018\" & Q_N & ".xlsx"
                    EE.Quit 'Excel終了
                    Set EE = Nothing '参照開放
            End With


EE(Excelオプジェクト)は保存できないのでエラーになるのですね。
新規ブックを名前を付けて保存するようにしましょう。
.Save は上書き保存なので新規ブックではエラーになりますので、.SaveAs で。

    Dim wb As Workbook
            With EE
                .ScreenUpdating = True
                Set wb = .Workbooks.Add
            End With
            '中略
            With EE
                WB.SaveAs "J:\シミュレート表_2018\" & Q_N & ".xlsx"
                WB.Close
                .Quit 'Excel終了
                Set EE = Nothing '参照開放
            End With

補足

質問の回答ではなく、改善のアドバイスです。
ExcelオブジェクトをRecordsetのレコード数分、生成したり解放したりしてますが、無駄ですね。重くなるだけです。ループ前に一回生成して、ループを抜けてから解放すればOKです。

    '略
    Dim wb As Object 'Workbook
    '略

       Set EE = CreateObject("Excel.Application")
       '本番はfalse
       EE.Visible = True
       EE.ScreenUpdating = True

       Do Until RS1.EOF

            Set wb = EE.Workbooks.Add '新規ブックを追加

            '略

            WB.SaveAs "J:\シミュレート表_2018\" & Q_N & ".xlsx"
            WB.Close 'ブックを閉じる

            rs1.Movenext
       Loop

       EE.Quit 'Excel終了
       Set EE = Nothing '参照開放

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/06/27 15:37

    回答ありがとうございます。
    やはり実行時エラー438が出てしまいます。保存場所をデスクトップに変えたりしてみましたが同様のエラーが出てしまいます。
    試しにwith EEの下に『Range("A1").Value = "仕入先"』と記入してみたところ書き換わりました。
    SaveAsがいけないのでしょうか。。。。

    キャンセル

  • 2018/06/27 15:52

    EE の保存ではなく新規ブックを名前をつけて保存するでないとダメでした。
    回答のコードを修正しておきました。

    キャンセル

  • 2018/06/27 16:04

    ありがとうございました。保存することが出来ました!

    ここから製表で作りこんで行こうと思いますのでまた色々ご教示ください。

    キャンセル

  • 2018/06/27 16:50

    もうひとつお伺いしてもよろしいでしょうか。
    ループで2回目の処理を行おうとしたら実行時エラー91でオブジェクト変数が設定されていないといわれました。↓この段階で
    『ActiveSheet.Cells(1, i + 1).Value = RS2.Fields(i).Name』

    wbを開放していないのが問題かと思い追加してみたのですが、結果変わらずでした。
    EEとwb以外にもなにか追記する必要があるのでしょうか?

    キャンセル

  • 2018/06/27 18:45

    ActiveSheet を使うのはさせたほうがいいでしょう。
    wb.WorkSheets(1) で最初のシートを参照できますので、これに置き換えてください。

    追記のアドバイスも参考にしてください。

    キャンセル

  • 2018/06/28 10:03

    ありがとうございました。ループがうまく行きました。

    キャンセル

同じタグがついた質問を見る

  • VBA

    1899questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1624questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • Access

    469questions

    Accessはマイクロソフトによるリレーショナルデータベース管理システムです。オブジェクト指向のアプリケーション作成に対応しており、テーブルや編集をはじめ、クエリ生成、入力フォーム作成、レポート作成など一通りの機能を備えています。