戯れ言葉

MS Access:エクセル(Excel)シートに書込む

カテゴリ:MSAccess 備忘録
タグ:

 書式ができあがっているエクセルの帳票にAccess のデータを書込んで次々印刷する。

 会社とかで、どこかの部署とか、自分で作ってたエクセルの帳票に、
 Access で作ったデーターを書込んで印刷する。
 そんなことが現実にでてきて、印刷したい書類は90数枚で、それぞれ内容が違うもの。
 で、データーはAccess に入力済み。

 エクセルで色んな帳票を作るのは日常茶飯事で、罫線を多用したり、特に合計や引き算足し算のある帳票はWord では作りませんねぇ。
 こんなエクセルで作った帳票をアクセスのレポートで同じデザインで作ろうとすると、かなり面倒で、何日もかかったりします。

 でも、Access から書込む手法を色々とネットで調べてみると、以外と簡単にできてしまいました。
 コンセプト : おまじないを盲目的に使う。

 まず、Access VBA で、参照設定が必要。
 Access2003 での設定で色反転部分が追加した参照設定。
Access2Exel.jpg

 Access のフォーム上にエクセルへの出力・印刷ボタンを作って、
 そのコマンドボタンの名前を OutExl とする。で、そのボタンのクリックイベント。
 変数名は当然任意に作れば良い。

Private Sub OutExl_Click()

  
  ' 以下3行はDAO のおまじない。
  ' いつもこれで
  Dim myDB As DAO.Database
  Dim myQD As DAO.QueryDef
  Dim myRS As DAO.Recordset

  
  ' エクセルを使用するためのおまじない。
  ' 変数名は当然 X なんかでも良い。
  Dim objExl As Object

  
  ' とりあえず何かのためのカウンター用変数を用意
  Dim Ctr As Long

  
  ' デバッグ用変数
  ' 動作チェック時は true を入れて確認用ルーチンを動かす。
  Dim Dbg As Boolean

  
  ' EXELに書き込むデータ 今回は1個で長整数
  Dim reqDT As Long

  
  ' デバッグ時は True にする
  Dbg = False

  
  ' おまじない
  Set myDB = CurrentDb

  
  ' データーを読込むテーブルを開く
  Set myRS = myDB.OpenRecordset("MasterData", dbOpenDynaset)

  
  ' レコードを読込む順序(ソートキー)を設定
  ' 今回は印刷する順序
  ' 読み込むテーブルがリンクテーブルでは
  ' 次の構文は無効なので、追加クエリー等で
  ' 全コピーした作業用テーブルを用意すること。
  myRS.Sort = "MasterOrder ASC,Yomi ASC"

  
  ' おまじない。
  Set myRS = myRS.OpenRecordset

  
    ' レコードのトップへ移動
    myRS.MoveFirst

  
  ' ここから
  Set objExl = CreateObject("Excel.Application")
  With objExl
    .Visible = True
    .UserControl = True
  ' ここまでもこのまま記述すること

    .Workbooks.Open ("C:\MyDatabase\社内伝票.xls")
    ' エクセルファイルのフルパス

    
    ' エクセルのシート名を指定
    .Worksheets("Sheet1").Select

    
    ' セルの番地に、データ 25 を書き込む
    .Range("p1").Value = "25"

    
    ' 全部の書類の書き込みデータが同じ
    ' なので固定データを書込んでいる。
    .Range("r1").Value = "4" 
    .Range("t1").Value = "1"

  
  ' デバッグ用ルーチン
  If Dbg Then
    
    ' テスト印刷なので 先頭データから3枚印刷
    For Ctr = 1 To 3
      .Range("c13").Value = "平成25年度 保守点検 " & myRS!BldName

      
      ' 何度も使用するデータは一旦変数に格納
      reqDT = myRS!ExpsTotal

      .Range("c19").Value = reqDT
      .Range("m19").Value = reqDT

      
      ' And や Or は構文の動作を考えるのが面倒なので
      ' ピンとくる方から書く
      ' 等号・不等号式の評価順に自信の無い時は( )で囲む
      If (myRS!RackTypeID = 22) Or (myRS!RackTypeID = 24) Then
        
        ' 他で書込まれるセルを
        ' 空白にしたいときは必ずヌルを入力する。
        .Range("m20") = ""
        .Range("r19") = ""

      Else
        
        ' 小数点以下を丸めるときは
        ' 前もって整数に変換して紛れをなくする
        ' エクセル上で小数点を持っていると
        ' 集計した時に表示されない小数点以下の数値が
        ' 影響する
        .Range("m20") = CLng(reqDT * 0.17)
        .Range("r19") = getExps - CLng(reqDT * 0.17)
      End If

      
      ' 印刷 1ページ目から 1ページ目まで 1部印刷
      .Application.Worksheets("Sheet1").PrintOut from:=1, To:=1, Copies:=1

    myRS.MoveNext

    Next Ctr

  
  ' デバッグでない メインのルーチン
  Else
    Do Until (myRS.EOF)
      
      ' ここには For Ctr の次から 
      ' Next Ctr の直前までがそのまま入る
    Loop
  End If
    
    ' False にすると保存するかしないかの確認なしに
    ' 上書きしないで終了する。
    .Application.DisplayAlerts = False
    .quit

  End With

  myRS.Close
  myDB.Close

End Sub

Comments 0

There are no comments yet.

Leave a reply
コメントをどうぞ

 お名前とか
 ブログやホームページのURLをどうぞ

パスワードを入力すると投稿後、訂正・削除が出来ます