Day4 オートメーションの応用例

Access 97/2000　オートメーションの応用例

Access のクロス集計クエリーは、複数の行見出しと１つの列見出しを指定することができます。ところが、今回紹介するような、複数の列見出しを指定したい場合がよくあります。本ゼミの最終回は、クロス集計クエリーで複数の列見出しを指定するテクニックを解説します。

Day4のサンプルデータベース（Day4.zip)を用意しましたので、事前にダウンロードしてWinZipで解凍してください。Day4.zipには、Day4.mdbが梱包されています。Day4.mdbは、以下の解説で使用するサンプルデータベースです。

　サンプルデータベースのダウンロード

GetRows()メソッドの使い方（その１）

Access を起動してサンプルデータベース(Day4.mdb)を開きます。

Automation Examplesのメニューが表示されますのでGetRowsメソッドの使い方（その１）を選択してShow Codeのボタンをクリックします。モジュールウィンドウにSample1()のソースコードが表示されます。

リスト１-Sample1のソースコード

Private Function Sample1()
'
' GetRowsメソッドの使い方（その１）
'
  Dim db As Database
  Dim rs As Recordset
  Dim strSQL As String
  Dim avarRecords As Variant
 
  Dim objExcel As Excel.Application
 
  DoCmd.Hourglass True
  
  strSQL = "SELECT 得意先コード, 得意先名 FROM 得意先;"
 
  Set db = CurrentDb
  Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

  avarRecords = rs.GetRows(3)
  
  Set objExcel = CreateObject("Excel.Application")


  With objExcel
    .Workbooks.Add
    .Range("A1").Value = "ｺｰﾄﾞ"
    .Range("B1").Value = "得意先名"
  
    .Range("A2").Value = avarRecords(0, 0)
    .Range("B2").Value = avarRecords(1, 0)
  
    .Range("A3").Value = avarRecords(0, 1)
    .Range("B3").Value = avarRecords(1, 1)
  
    .Range("A4").Value = avarRecords(0, 2)
    .Range("B4").Value = avarRecords(1, 2)
    
    .Visible = True
    MsgBox "Hello Sample1"
    On Error Resume Next
    .ActiveWorkbook.Close False
    .Quit
  End With
  
  DoCmd.Hourglass False
  
  rs.Close
  db.Close
  Set rs = Nothing
  Set db = Nothing
  Set objExcel = Nothing

End Function

Sample1()は、得意先テーブルから得意先コードと得意先名を抽出してExcel のワークシート上に出力しています。前回までは、レコードセットをExcel のワークシートに出力するのにCopyFromRecordsetメソッドを使用しましたが、今回はGetRowsメソッドを使用しています。

GetRows(3)は、レコードセットの先頭から３レコード読み込んで二次元の配列変数に格納します。

avarRecords = rs.GetRows(3)

１番目の次元(Dimension)には、フィールドの内容が格納され,２番目の次元には、レコード番号が格納されます。

先頭レコードの得意先コードは、avarRecords(0, 0)のように参照します。２番目の得意先コードは、avarRecords(0, 1)のように参照します。以下同様、３番目の得意先コードは、avarRecords(0, 2)にように参照します。

先頭レコードの得意先名は、avarRecords(1, 0)のように参照します。２番目の得意先名は、avarRecords(1, 1) になります。以下同様、３番目の得意先名は、avarRecords(1, 2)のように参照します。

.Range("A2").Value = avarRecords(0, 0)  ' 得意先コード１
.Range("B2").Value = avarRecords(1, 0)  ' 得意先名１
  
.Range("A3").Value = avarRecords(0, 1)  ' 得意先コード２
.Range("B3").Value = avarRecords(1, 1)  ' 得意先名２
  
.Range("A4").Value = avarRecords(0, 2)  ' 得意先コード３
.Range("B4").Value = avarRecords(1, 2)  ' 得意先名３

Sample1()では、ワークシート上のセルを参照するのにRange()を使用しています。

Sample1()のモジュールウィンドウを閉じます。
Automation ExamplesのメニューからGetRowsメソッドの使い方（その１）を選択してRun Exampleのボタンをクリックします。

Excel が起動されてワークシート上に得意先コードと得意先名が出力されます。

図１-ワークシート上に得意先テーブルを出力した例その１

WindowsのタスクバーからAccessをクリックしてフォーカスを移動します。
Hello Sample1のメッセージが表示されていますのでOKをクリックしてExcel を終了します。
Automation ExamplesのメニューからExit Microsoft Accessのボタンをクリックして終了します。

GetRows()メソッドの使い方（その２）

Access を起動してサンプルデータベース(Day4.mdb)を開きます。

Automation Examplesのメニューが表示されますのでGetRowsメソッドの使い方（その2）を選択してShow Codeのボタンをクリックします。モジュールウィンドウにSample2()のソースコードが表示されます。

リスト２-Sample2のソースコード

Private Function Sample2()
'
' GetRows()メソッドの使い方（その２）
'
  Dim db As Database
  Dim rs As Recordset
  Dim strSQL As String
  Dim avarRecords As Variant
 
  Dim objExcel As Excel.Application
  Dim intRow As Integer
  Dim intFld As Integer
  
  strSQL = "SELECT 得意先コード, 得意先名 FROM 得意先;"
 
  DoCmd.Hourglass True
 
  Set db = CurrentDb
  Set rs = db.OpenRecordset(strSQL)

  avarRecords = rs.GetRows(10)

  Set objExcel = CreateObject("Excel.Application")

  With objExcel
    .Workbooks.Add
    ' Find upper bound of second dimension (record).
    For intRow = 0 To UBound(avarRecords, 2)
      ' Find upper bound of first dimension (field).
      For intFld = 0 To UBound(avarRecords, 1)
        ' Put data from each row in array.
        .Cells(intRow + 1, intFld + 1).Value = _ 
           avarRecords(intFld, intRow)
      Next intFld
    Next intRow
    
    .Visible = True
    MsgBox "Hello Sample2"
    On Error Resume Next
    .ActiveWorkbook.Close False
    .Quit
  End With
  
  DoCmd.Hourglass False
  rs.Close
  db.Close
  Set rs = Nothing
  Set db = Nothing
  Set objExcel = Nothing

End Function

Sample2()では、Excel のワークシート上にデータを出力するのにCells()を使用しています。Cells()では、ワークシート上のセルを参照するのに行番号と列番号を指定します。

Cells(1,1)は、A1のセルを参照します。Cells(2,1)は、A2のセルを参照します。

外側のFor intRow = 0 To UBound(avarRecords, 2)... Nextループでは、配列変数のレコードを処理します。内側のFor intFld = 0 To UBound(avarRecords, 1)... Nextループでは、配列変数のフィールドを処理します。

For intRow = 0 To UBound(avarRecords, 2)
      For intFld = 0 To UBound(avarRecords, 1)
        .Cells(intRow + 1, intFld + 1).Value = _ 
           avarRecords(intFld, intRow)
      Next intFld
Next intRow

ここで注意して頂きたいのですが、Cells()は１から始まりますが、avaRecords()の配列を参照するときのインデックスは0から始まります。このため、Cells(intRow + 1, intFld + 1)のように配列のインデックスに＋１加算しています。

Sample2()のモジュールを閉じます。
Automation ExamplesのメニューからGetRowsメソッドの使い方（その２）を選択してRun Exampleのボタンをクリックします。

Excel が起動されてワークシート上に得意先コードと得意先名が出力されます。

図２-ワークシート上に得意先テーブルを出力した例その２

WindowsのタスクバーからAccessをクリックしてフォーカスを移動します。
Hello Sample2のメッセージが表示されていますのでOKをクリックしてExcel を終了します。
Automation ExamplesのメニューからExit Microsoft Accessのボタンをクリックして終了します。

クロス集計クエリーで複数の列見出しを作成するには

Access を起動してサンプルデータベース(Day4.mdb)を開きます。
Automation Examplesのメニューが表示されますのでDisplay Database Windowのボタンをクリックします。

データベースウィンドウのクエリーからqry複数の列数を指定したクロス集計を選択してデザインボタンをクリックします。

図３-複数の列数を指定したクロス集計

図３のクロス集計クエリーの式１には、列見出しとして商品コードと商品名を指定しています。商品名の前に商品コードを追加しているのは、列見出しが商品コード順に表示されるようにするためです。

式1: [受注明細]![商品コード] & [商品名]

図３の式２には演算として、サイズと数量（枚数）を指定しています。サイズと数量は、Excel のワークシート上に分離して表示するために区切り文字としてスラッシュ（/）を付加しています。

式2: "/" & First([サイズ]) & "/" & Sum([数量])

クエリーメニューからビューアイコンをクリックして、クロス集計クエリーを実行します。

図４-クロス集計クエリーの実行結果

図４に示すように列見出しには、商品コードと商品名が表示されています。Excel上に表示するときは、列見出しから商品コードを除去して商品名のみ表示します。

図４のクエリーの値には、サイズと数量がスラッシュ(/)で区切られて/17/1のように表示されていますが、Excel上では分離して表示します。
クエリーを閉じたら、データベースウィンドウからフォームタブをクリックしてAutomation Switchboardを開きます。

Automation Switchboardメニューからクロス集計クエリーで複数の列見出しを作成するにはを選択してShow Codeボタンをクリックします。モジュールウィンドウにSample3()のソースコードが表示されます。

リスト３-Sample3()のソースコード

Private Function Sample3()
'
' クロス集計クエリーで複数の列見出しを作成するには
'
  Dim db As Database
  Dim rs As Recordset
  
  Dim objExcel As Excel.Application
  Dim rngRange As Range
  
  Dim avarRecords As Variant
  Dim intRecordCount As Integer
  Dim intFieldCount As Integer
  Dim intFld As Integer
  
  Dim intI As Integer
  Dim intRow As Integer
  Dim intCol As Integer
  Dim intRows As Integer
  Dim intCols As Integer
  Dim intCellRow As Integer
  Dim intCellCol As Integer
  
  Dim strSumR1 As String
  
  DoCmd.Hourglass True
  
  Set db = CurrentDb
  Set rs = db.OpenRecordset("qry複数の列数を指定したクロス集計")
  
  Set objExcel = CreateObject("Excel.Application")

  With objExcel
    .Workbooks.Add
    With rs
      .MoveLast
      .MoveFirst
      intRecordCount = .RecordCount
      intFieldCount = .Fields.Count
    
      ' Accessのﾌｨｰﾙﾄﾞ名をExcelの列見出しとして使用する
      intRow = 1
      intCol = 1
      For intFld = 0 To .Fields.Count - 1
        If intFld = 0 Then
          objExcel.Cells(intRow, intCol).Value = .Fields(intFld).Name
          intCol = intCol + 1
        Else
          objExcel.Cells(intRow, intCol).Value = Mid(.Fields(intFld).Name, 4)
          objExcel.Cells(intRow + 1, intCol).Value = "サイズ"
          objExcel.Cells(intRow + 1, intCol + 1).Value = "枚数"
          intCol = intCol + 2
        End If
      Next intFld
      
      ' 配列変数にｸﾛｽ集計ｸｴﾘｰのﾃﾞｰﾀを取り込む
      avarRecords = .GetRows(intRecordCount)
      intCols = UBound(avarRecords, 1)    ' 0-N
      intRows = UBound(avarRecords, 2)    ' 0-N
    End With
      
    ' 配列変数からAccess97のデータをExcel97のワークシートに貼り付ける
    intCellCol = 1
    For intFld = 0 To intFieldCount - 1
        intCellRow = 3
        ' アイテムの情報は２カラム（サイズ、枚数）に分割してセルに格納する
        If intFld > 0 Then
            For intRow = 0 To intRows
               .Cells(intCellRow + intRow, intCellCol).Value = _
                  GetPart(0, avarRecords(intFld, intRow)) ' サイズ
            Next intRow
            For intRow = 0 To intRows
               .Cells(intCellRow + intRow, intCellCol + 1).Value = _
                  GetPart(1, avarRecords(intFld, intRow)) ' 枚数
            Next intRow
            intCellCol = intCellCol + 2
        Else
            For intRow = 0 To intRows
               .Cells(intCellRow + intRow, intCellCol).Value = _
                  avarRecords(intFld, intRow)             ' 固定部
            Next intRow
            intCellCol = intCellCol + 1
        End If
    Next intFld


    ' アイテム別枚数の合計を計算してｻｲｽﾞ＋枚数のセルを結合する 
    intRow = intRecordCount + 3     ' アイテムの合計用セルを計算
    intCol = 3                      ' アイテムの枚数のセルを計算
    strSumR1 = Format(3 - intRow)   ' Sum関数のR[-99]Cを計算
  
    ' 合計のタイトルを埋め込む
    .Cells(intRow, 1).Value = "合計"
  
    '　各アイテムに対してSUM関数を埋め込んで
    '  サイズ、枚数を結合する
    For intI = 1 To intFieldCount - 1
        ' 合計用のセルにSUM関数を埋め込む
        .Cells(intRow, intCol).Select
        .ActiveCell.FormulaR1C1 = _ 
           "=SUM(R[" & strSumR1 & "]C:R[-1]C)" ' =SUM(R[-99]C:R[-99]C
        
        ' サイズ＋枚数のセルを選択して結合する
        .Range(.Cells(intRow, intCol - 1).Address _
            & ":" & .Cells(intRow, intCol).Address).Select
        With .Selection
             .HorizontalAlignment = xlRight
             .VerticalAlignment = xlCenter
             .MergeCells = True
        End With
        
        ' 列見出し１の２個のセルを結合する
        .Range(.Cells(1, intCol - 1).Address _
            & ":" & .Cells(1, intCol).Address).Select
        With .Selection
             .HorizontalAlignment = xlCenter
             .VerticalAlignment = xlCenter
             .MergeCells = True
        End With
        
        intCol = intCol + 2
    Next intI

    ' 罫線を引く
      
    .ActiveSheet.UsedRange.Select
    .Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    .Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
    With .Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
      
      
    Set rngRange = .ActiveSheet.UsedRange
      
    ' 列見出しをセンタリングする
    rngRange.Offset(0, 0).Rows(1).Select
    With .Selection
        .HorizontalAlignment = xlCenter
    End With
      
    ' 行見出しにセルの幅を合わせる
    rngRange.Offset(0, 0).Columns(1).AutoFit
      
    '　ページのタイトルを設定する
    With .ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = "$A:$A"
    End With
      
    ' ページヘッダー/フッターを設定
    With .ActiveSheet.PageSetup
        .LeftHeader = "ユニフォーム集計表"
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&P / &N"
        .RightFooter = ""
    End With
  
    ' 用紙サイズと印刷の向き（縦横）設定
    With .ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
    End With
      
    ' Excelを可視状態にする
    .Visible = True
     MsgBox "Hello Sample3"
      
     On Error Resume Next
     .ActiveWorkbook.Close False
     .Quit

  End With
  DoCmd.Hourglass False
  rs.Close
  db.Close
  Set rs = Nothing
  Set db = Nothing
  Set objExcel = Nothing

End Function

Sample3()では、クロス集計クエリーをExcelのワークシート上に出力して表示します。クロス集計クエリーの列見出しをサイズと枚数に分離して表示するために、レコードセットをGetRows()メソッドで配列変数に格納してから処理しています。

OpenRecordset()でクロス集計クエリー名を指定してレコードセットを開いたら、CreateObject()でExcel を起動します。

クエリーの列見出しには、商品コードと商品名が表示されますが、Excel上の列見出しには商品コードを除去して商品名のみ表示します。また、２行目の列見出しとしてサイズと枚数も表示します。

リスト３ＡのFor intFld = 0 To .Fields.Count - 1... Nextループでは、図５に示すようにワークシート上に列見出しを出力しています。intFld = 0のときは、着用者名を出力します。intFldが0以外のときは、列見出しとして商品名（ジャケット）を出力します。また、２行目の列見出しにはサイズと枚数を出力します。

図５-ワークシート上に複数の列見出しを出力した例

リスト３A

intRow = 1
intCol = 1
For intFld = 0 To .Fields.Count - 1
   If intFld = 0 Then
      objExcel.Cells(intRow, intCol).Value = .Fields(intFld).Name
      intCol = intCol + 1
   Else
      objExcel.Cells(intRow, intCol).Value = Mid(.Fields(intFld).Name, 4)
      objExcel.Cells(intRow + 1, intCol).Value = "サイズ"
      objExcel.Cells(intRow + 1, intCol + 1).Value = "枚数"
      intCol = intCol + 2
   End If
Next intFld

リスト３ＢのFor intFld = 0 To intFieldCount - 1... Nextループでは、配列変数からワークシート上に行見出し、サイズ、枚数を出力しています。intFld=0のときは、行見出しですから配列変数の着用者名（葛西　春子、葛西　夏子、.....）をそのままセルに出力します。intFld>0のときは、サイズと枚数が連結していますからGetPart()関数を呼び出してサイズと枚数を分離します。

GetPart(0, "/17/1")のように呼び出すと、サイズの17が戻り値として返されます。

GetPart(1, "/17/1")のように呼び出すと、枚数の1が戻り値として返されます。

GetPart()関数は、basAutomationモジュールの最後にありますので説明は省略します。

図６-ワークシート上に行見出しとサイズ、枚数を出力した例

リスト３Ｂ

intCellCol = 1
For intFld = 0 To intFieldCount - 1
    intCellRow = 3    
    If intFld > 0 Then
        For intRow = 0 To intRows
            .Cells(intCellRow + intRow, intCellCol).Value = _
              GetPart(0, avarRecords(intFld, intRow)) ' サイズ
        Next intRow
        For intRow = 0 To intRows
            .Cells(intCellRow + intRow, intCellCol + 1).Value = _
              GetPart(1, avarRecords(intFld, intRow)) ' 枚数
        Next intRow
        intCellCol = intCellCol + 2
    Else
        For intRow = 0 To intRows
            .Cells(intCellRow + intRow, intCellCol).Value = _
               avarRecords(intFld, intRow)  ' 固定部
        Next intRow
        intCellCol = intCellCol + 1
    End If
Next intFld

リスト３ＣのFor intI = 1 To intFieldCount - 1... Nextループでは、枚数の合計を計算するSum()関数を埋め込んで、見出しと合計の連続するセルを結合しています。

ActiveCell.FormulaR1C1 = "=SUM(R[" & strSumR1 & "]C:R[-1]C)"では、図７に示すように合計のセルにSum()関数を埋め込んでいます。Sum()関数で指定する範囲は、合計セル(C7)を基点に相対アドレス Sum(R[-4]C:R[-1]C)で指定します。

図７-枚数集計用のSum()を埋め込んだ例

図８に示すようにジャケットや合計のセルを結合するには、Ｒａｎｇｅ（）．Selectで範囲を選択してMergeCells = Trueで結合します。

例えば、B1とC1のセルを結合するには、Range("B1:C1").Selectで範囲を選択してMergeCells=Trueで結合します。

図８-セルを結合した例

リスト３Ｃ


For intI = 1 To intFieldCount - 1
    ' 合計用のセルにSUM関数を埋め込む
    .Cells(intRow, intCol).Select
    .ActiveCell.FormulaR1C1 = _ 
       "=SUM(R[" & strSumR1 & "]C:R[-1]C)" ' =SUM(R[-99]C:R[-99]C

    ' サイズ＋枚数のセルを選択して結合する  
    .Range(.Cells(intRow, intCol - 1).Address _
        & ":" & .Cells(intRow, intCol).Address).Select
    With .Selection
         .HorizontalAlignment = xlRight
         .VerticalAlignment = xlCenter
         .MergeCells = True
    End With

    ' 列見出し１の２個のセルを結合する    
    .Range(.Cells(1, intCol - 1).Address _
        & ":" & .Cells(1, intCol).Address).Select
    With .Selection
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
         .MergeCells = True
    End With
        
    intCol = intCol + 2
Next intI

枚数の合計を計算するSum()関数を埋め込んだら、罫線を引いて列見出し、行見出し等の印刷条件を設定してExcelを可視状態にします。

Sample3()のモジュールを閉じます。
Automation Examplesのメニューからクロス集計クエリーで複数の見出しを作成するにはを選択してRun Exampleのボタンをクリックします。

Excel が起動されてワークシート上にクロス集計のデータが表示されます。

図９-Sample3の実行結果

Sample3の結果は、図９に示すように着用者名のＡ１とＡ２の間に罫線が引かれていたり、サイズが不揃いになっています。これらの問題は、Excel のマクロで書式を設定することにより解決することができます。

しかし、Excel のマクロを使用してセルの書式を再設定すると処理速度が低下しますのでSample4()で、テンプレートを使用してこれらの問題を解決する方法を解説します。

WindowsのタスクバーからAccessをクリックしてフォーカスを移動します。
Hello Sample3のメッセージが表示されていますのでOKをクリックしてExcelを終了します。
Automation ExamplesのメニューからExit Microsoft Accessのボタンをクリックして終了します。

Excel のテンプレートを利用するには

Access を起動してサンプルデータベース(Day4.mdb)を開きます。

Automation Examplesのメニューが表示されますのでExcel のテンプレート利用するにはを選択してShow Codeのボタンをクリックします。モジュールウィンドウにSample4()のソースコードが表示されます。

リスト４-Sample4のソースコード

Private Function Sample4()
'
' Excelのテンプレートを利用するには
'
  Dim db As Database
  Dim rs As Recordset
  
  Dim objExcel As Excel.Application
  Dim rngRange As Range
  Dim rngData As Range
  
  Dim avarRecords As Variant
  Dim intRecordCount As Integer
  Dim intFieldCount As Integer
  Dim intFld As Integer
  
  Dim intI As Integer
  Dim intRow As Integer
  Dim intCol As Integer
  Dim intRows As Integer
  Dim intCols As Integer
  Dim intCellRow As Integer
  Dim intCellCol As Integer
  
  Dim strSumR1 As String
  Dim strFilename As String
  
  DoCmd.Hourglass True
  
  Set db = CurrentDb
  Set rs = db.OpenRecordset("qry複数の列数を指定したクロス集計")
  
  Set objExcel = CreateObject("Excel.Application")
  strFilename = AppPath() & "template"
  
  With objExcel
    .Workbooks.Open FileName:=strFilename, ReadOnly:=True
    With rs
      .MoveLast
      .MoveFirst
      intRecordCount = .RecordCount
      intFieldCount = .Fields.Count
    
      ' Accessのﾌｨｰﾙﾄﾞ名をExcelの列見出しとして使用する
      intRow = 1
      intCol = 1
      For intFld = 0 To .Fields.Count - 1
        If intFld = 0 Then
          objExcel.Cells(intRow, intCol).Value = .Fields(intFld).Name
          intCol = intCol + 1
        Else
          objExcel.Cells(intRow, intCol).Value = Mid(.Fields(intFld).Name, 4)
          objExcel.Cells(intRow + 1, intCol).Value = "サイズ"
          objExcel.Cells(intRow + 1, intCol + 1).Value = "枚数"
          intCol = intCol + 2
        End If
      Next intFld
      
      ' 配列変数にｸﾛｽ集計ｸｴﾘｰのﾃﾞｰﾀを取り込む
      avarRecords = .GetRows(intRecordCount)
      intCols = UBound(avarRecords, 1)    ' 0-N
      intRows = UBound(avarRecords, 2)    ' 0-N
    End With
      
    ' 配列変数からAccess97のデータをExcel97のワークシートに貼り付ける
    intCellCol = 1
    For intFld = 0 To intFieldCount - 1
        intCellRow = 3
        ' アイテムの情報は２カラム（サイズ、枚数）に分割してセルに格納する
        If intFld > 0 Then
            For intRow = 0 To intRows
               .Cells(intCellRow + intRow, intCellCol).Value = _
                  GetPart(0, avarRecords(intFld, intRow)) ' サイズ
            Next intRow
            For intRow = 0 To intRows
               .Cells(intCellRow + intRow, intCellCol + 1).Value = _
                  GetPart(1, avarRecords(intFld, intRow)) ' 枚数
            Next intRow
            intCellCol = intCellCol + 2
        Else
            For intRow = 0 To intRows
               .Cells(intCellRow + intRow, intCellCol).Value = _
                  avarRecords(intFld, intRow)             ' 固定部
            Next intRow
            intCellCol = intCellCol + 1
        End If
    Next intFld

    ' アイテム別枚数の合計を計算してｻｲｽﾞ＋枚数のセルを結合する
    intRow = intRecordCount + 3     ' アイテムの合計用セルを計算
    intCol = 3                      ' アイテムの枚数のセルを計算
    strSumR1 = Format(3 - intRow)   ' Sum関数のR[-99]Cを計算
  
    ' 合計のタイトルを埋め込む
    .Cells(intRow, 1).Value = "合計"
    .ActiveCell.Select
    With .Selection
         .HorizontalAlignment = xlCenter
         .VerticalAlignment = xlCenter
    End With
  
  
    '　各アイテムに対してSUM関数を埋め込んで、サイズ、枚数を結合する
    For intI = 1 To intFieldCount - 1
        ' 合計用のセルにSUM関数を埋め込む
        .Cells(intRow, intCol).Select
        .ActiveCell.FormulaR1C1 = "=SUM(R[" & strSumR1 & "]C:R[-1]C)"
        
        ' サイズ＋枚数のセルを選択して結合する
        .Range(.Cells(intRow, intCol - 1).Address _
            & ":" & .Cells(intRow, intCol).Address).Select
        With .Selection
             .HorizontalAlignment = xlRight
             .VerticalAlignment = xlCenter
             .MergeCells = True
        End With
        intCol = intCol + 2
    Next intI

    ' 罫線を引く
    Set rngRange = .ActiveSheet.UsedRange
    Set rngData = rngRange.Offset(0, 0).Resize(intRecordCount + 3, _
        rngRange.Columns.Count)
        
    rngData.Select
    .Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    .Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
    With .Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
      
    '　ページのタイトルを設定する
    With .ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$2"
        .PrintTitleColumns = "$A:$A"
    End With
      
    ' ページヘッダー/フッターを設定
    With .ActiveSheet.PageSetup
        .LeftHeader = "ユニフォーム集計表"
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&P / &N"
        .RightFooter = ""
    End With
  
    ' 用紙サイズと印刷の向き（縦横）設定
    With .ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
    End With
      
    ' Excelを可視状態にする
    .Visible = True

    ' プレビュー印刷
    .ActiveSheet.UsedRange.Select
    .Selection.PrintOut Preview:=True, Collate:=True
      
     MsgBox "Hello Sample4"
      
     On Error Resume Next
     .ActiveWorkbook.Close False
     .Quit

  End With
  DoCmd.Hourglass False
  rs.Close
  db.Close
  Set rs = Nothing
  Set db = Nothing
  Set objExcel = Nothing

End Function

Sample4()では、Excel のテンプレートを開いてこのテンプレートにクロス集計を出力します。

図１０-クロス集計用のテンプレート

クロス集計用のテンプレートには、列見出しのセルを結合したり、サイズと枚数を出力するセルの書式を設定しています。

Excel のテンプレート(Template.xls)を開くには、WorkbooksのOpenメソッドを使用します。strFilenameには、Template.xlsが格納されているフルパス名(例：C:\Access97\Automation\Template)を指定します。また、テンプレートは上書きされると困りますので読み込み専用で開きます。

リスト４Ａで使用しているAppPath()関数は、現在開かれているデータベース（Day4.mdb)が存在するパス名を返します。例えば、Day4.mdbがC:\Access97\Automation\Day44.mdbにあるとき、 C:\Access97\Automation\ を返します。

AppPath()関数は、basAutomationモジュールの最後にありますので説明は省略します。

リスト４A


Set objExcel = CreateObject("Excel.Application")
strFilename = AppPath() & "template"
  
With objExcel
    .Workbooks.Open FileName:=strFilename, ReadOnly:=True


End With

Sample4()のモジュールを閉じます。
Automation ExamplesのメニューからExcel のテンプレートを使用するにはを選択してRun Exampleのボタンをクリックします。

Excel が起動されてワークシート上にクロス集計のデータが表示されます。

図１１-Sample4()の実行結果

これでかなり見栄えの良いレポートが作成できたと思います。

WindowsのタスクバーからAccessをクリックしてフォーカスを移動します。
Hello Sample4のメッセージが表示されていますのでOKをクリックしてExcel を終了します。
Automation ExamplesのメニューからExit Microsoft Accessのボタンをクリックして終了します。