ACCESS2007の相談です

Question

初めて投稿します。

現在、会社で古い端末とオフィス(OSは７にオフィスは2007)を利用しています。

業務用のACCESSツールを作っているのですが、２つ挙動がおかしい点がありますのでご相談です。

・ACCESS上でEXCELを動かすVBAのRANGE構文が必ず2回に1回エラーとなる

　これはACCESSのクエリをEXCELのテンプレートに貼付後にテンプレートを修正するVBAで発生します。

　　(利用者がEXCEL派なのでレポートは嫌みたいです・・・)

　　コードとエラー箇所ですが下記になります

　　　~略~

　　　「レコードセットを開いてフォームの値を用いてクエリを作る」

　　　「クエリの値を指定されたEXCELテンプレートの指定の位置へ貼り付ける」

           ~略~

         '見栄えの修正

         ActiveSheet.Activate

         Dim 行 As Long

         行 = 0

         行 = Range("C38").End(xlUp).Row　←このrangeが必ず２回に１回エラー４１を吐く

         行 = 行 + 4

         Rows(行 & ":" & 38).Delete

         Range("J13").Select

　　※予めデータ数の変動が想定されるのでテンプレートは広めにとってある

　　　テンプレートの最終行(C38)から取り込んだデータの終端を求め見栄えを調整する

　　RANGEがなぜか2回に1回エラー41を吐きます。

　　onerrも試しましたがうまく行かず困っております。

　　古いので再現性が低くMSの有償サポートも頼れないですし、ネットを調べても出てこず途方にくれています。

　　レポートで出せば？と言われればそれまでですが使用者がEXCELじゃないとヤダ！ということで吐き出す形式にしております。

　・ACCESSファイルが共有できない

　　もともと共有モードに設定をし利用者のいる部署のNASにリンクテーブルとその他を分けて別ファイル保存しています。

　　しかしその他のメインの操作したいファイルは一人しか開けません。

　　上司からは、設定調べてみな！できると思うからとだけ言われ調べましたがこちらも答えがわからず困っています。

　　上司は元エンジニアなので聞けば教えてくれるかと思いますがまずは自分で解決したいと思っております。

どうかお知恵を拝借させてください。

Answer 1

> ActiveSheet.Activate

> 行 = Range("C38").End(xlUp).Row

> Rows(行 & ":" & 38).Delete

> Range("J13").Select

上記のように「上位（最上位）のオブジェクトへの参照を省略したコード」は、

外部の Office アプリケーション（この場合は Access ）から

OLE オートメーションを実行する場合においては無効です。

> 行 = Range("C38").End(xlUp).Row

また、Access データベース側の VBA プロジェクトの参照設定に、

Microsoft Excel *.* Object Library は追加されているのでしょうか。

> もともと共有モードに設定をし利用者のいる部署のNASに

> リンクテーブルとその他を分けて別ファイル保存しています。

NAS 上にバックエンドとなる mdb / accdb ファイルを保存し、

各クライアントにはフロントエンドとなる mdb / accdb ファイルを

配布している、という意味でしょうか。

> 上司は元エンジニアなので聞けば教えてくれるかと思いますが

> まずは自分で解決したいと思っております。

こういうのは「自分で解決」っていうんですかね。

（聞く相手が「上司」か「ネット上の誰か」の違いでしかない）

Answer 2

・Office 2007 のMicrosoft社のサポートは 2017年10月10日に終了しました。

Microsoft社のサポートが終了したOffice 2007 を使用することは Security更新Program の提供がなく Security Risk が高まり 危険な状態になっています。

Office 2007 は使用しないでください。

Security Risk を軽視してはいけません。

その様なSecurity Risk の高いOffice2007を会社で使用しているとは信じ難いですね。

会社では Office 2007 のMicrosoft社のサポートが終了する前に 話題にならなかったのですか？

Windows 7 のMicrosoft社のサポートが2020年1月14日で終了するのはご存知ですよね？

こちらの対策は会社では考えていますか？

 【 2017 年 10 月 10 日 (火) に Office 2007 の延長サポートが終了しました 】

　https://www.microsoft.com/ja-jp/office/2007/end-of-support/office.aspx

Answer 3

> EXCELアプリケーションを起動してからの貼り付け

> のコード部分は省略しております。

出来ればその辺りのコードも含めて掲載されることをお奨めします。

> ACCESSのクエリをEXCELのテンプレートに貼付後にテンプレートを修正するVBA

> 「レコードセットを開いてフォームの値を用いてクエリを作る」

> 「クエリの値を指定されたEXCELテンプレートの指定の位置へ貼り付ける」

例えば「ある SELECT 文の実行結果を新規作成した Excel ブックに出力する」

という処理を Access のモジュールから実行する場合は次のような形になります。

（実行時バインディングではなく事前バインディングを採用した場合）

（標準モジュール）

---

Sub subOutputToExcel()

On Error GoTo Err_subOutputToExcel

    Dim db As DAO.Database

    Dim rs As DAO.Recordset

    Dim fld As DAO.Field

    Dim xlsApp As Excel.Application

    Dim xlsWorkbook As Excel.Workbook

    Dim xlsWorksheet As Excel.Worksheet

    Dim xlsRange As Excel.Range

    Dim strSQL As String

    Dim lngRow As Long

    Dim lngColumn As Long

    Dim lngStartRow As Long

    Dim lngStartColumn As Long

    Dim lngLastRow As Long

    Dim lngLastColumn As Long

    Set db = CurrentDb

    '[テーブル1]のうち、[ID]の値が 10 未満であるレコードを抽出し、

    '[ID]の昇順に並べ替えた結果を得る SELECT 文

    strSQL = "SELECT * FROM [テーブル1]" & _

             " WHERE [ID] < 10" & _

             " ORDER BY [ID];"

    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

    If rs.EOF Then

        Set rs = Nothing

        Set db = Nothing

        MsgBox "出力対象となるレコードがありません。", _

               vbInformation, _

               "該当データなし"

        Exit Sub

    End If

    'Excelアプリケーションの新規インスタンスの生成と参照の取得

    Set xlsApp = New Excel.Application

    xlsApp.ScreenUpdating = False

    '新規ブックの作成と参照の取得

    '（既存のブックを開く場合は Add メソッドではなく

    'Open メソッドを呼び出し、その戻り値を取得する）

    Set xlsWorkbook = xlsApp.Workbooks.Add

    'ブックの1つめのワークシートへの参照を取得

    Set xlsWorksheet = xlsWorkbook.Worksheets(1)

    '列見出し行の出力

    For lngColumn = 1 To rs.Fields.Count

        xlsWorksheet.Cells(1, lngColumn).Value = rs.Fields(lngColumn - 1).Name

    Next

    'レコードセットの出力

    xlsWorksheet.Cells(2, 1).CopyFromRecordset rs

    '使用中のセル範囲の取得

    Set xlsRange = xlsWorksheet.UsedRange

    '以下、セル範囲の編集

    With xlsRange

        lngStartRow = 1

        lngStartColumn = 1

        lngLastRow = .Rows.Count

        lngLastColumn = .Columns.Count

        '行の高さ

        .RowHeight = 16

        '全セルの罫線の書式設定

        With .Borders

            .LineStyle = xlContinuous

            .Weight = xlHairline

            .Color = RGB(0, 0, 0)

        End With

        '表の外枠の罫線の書式設定

        .Borders(xlEdgeTop).Weight = xlMedium

        .Borders(xlEdgeLeft).Weight = xlMedium

        .Borders(xlEdgeBottom).Weight = xlMedium

        .Borders(xlEdgeRight).Weight = xlMedium

        '先頭行（列見出し行）の書式設定

        With .Range(.Cells(lngStartRow, lngStartColumn), _

                    .Cells(lngStartRow, lngLastColumn))

            .Borders(xlEdgeBottom).LineStyle = xlDouble

            .Font.Bold = True

            .Interior.Color = RGB(204, 204, 204)

            .HorizontalAlignment = xlCenter

        End With

        '列幅の自動調整

        .Columns.AutoFit

        '最終セルの2行下のセルの設定

        With .Cells(lngLastRow, lngLastColumn).Offset(2, 0)

            .Value = "レコード件数: " & rs.RecordCount & " 件"

            .HorizontalAlignment = xlRight

        End With

    End With

    '先頭行の固定

    With xlsApp.ActiveWindow

        .SplitRow = 1

        .FreezePanes = True

    End With

    'ワークシートのページ設定

    With xlsWorksheet.PageSetup

        .PaperSize = xlPaperA4

        .Orientation = xlLandscape

        .Zoom = False

        .FitToPagesWide = 1

        .FitToPagesTall = 1

        .CenterHeader = "&A"

        .RightHeader = "&D &T"

        .CenterFooter = "&P / &N"

    End With

'終了処理

Exit_subOutputToExcel:

On Error Resume Next

    xlsApp.Visible = True

    xlsApp.ScreenUpdating = True

    xlsApp.UserControl = True

    Set xlsRange = Nothing

    Set xlsWorksheet = Nothing

    Set xlsWorkbook = Nothing

    Set xlsApp = Nothing

    Set rs = Nothing

    Set db = Nothing

    Exit Sub

'エラー時処理

Err_subOutputToExcel:

    MsgBox Err.Number & ": " & Err.Description, _

           vbCritical, _

           "実行時エラー (subOutputToExcel)"

    Resume Exit_subOutputToExcel

End Sub

---

重要なポイントは、 Excel の最上位オブジェクトである

Excel.Application オブジェクトへの参照をオブジェクト変数に保持し、

そのメンバーや下位のオブジェクトを明示的に参照できるような

コードを記述する、ということです。

Answer 4

お返事ありがとうございました。

オブジェクトライブラリーの設定、EXCELアプリケーションを起動してからの貼り付け

のコード部分は省略しております。

もし無効であれば毎回デバッグ表示になると思いますが、ちがうのでしょうか？

私も少し齧った程度の知識で自分たちで使うVBA知識しかないですが毎回同じエラーであれば対処ができます・・・

ただ今回は「なぜか２回に１回だけエラーになる」というところです。

そうなりますとやはりonerrか現場の人には申し訳ないけどもレポートで対応してください。

になると思います。

たしかに上司に聞けば早いですね。今は私の部署は経理作業もあるので落ち着いたら聞いてみます。

また節約のためかもしれませんが７と２００７を利用しているため、

一気にシステムの組み換えになったその際にも大幅なデバッグ作業があるのは承知済みです。

Answer 5

システム周りの稟議や管理については私が入社する約2年以前から上長が担当しているため私は関与しておりません。

サポートの件は私も十分承知です。あるものを使って。と言われている以上、これ以上の対策は私にはできません。

現状使っているものなのでシステム入れ替えの際には、コード修正を含めた動作チェックが必要なことも承知です。

お返事ありがとうございました。