りんちゃんの日記

日常を書き留めていきます。

Access エクセル出力

Private Sub test2_Click()

'ADOセット定義
    Dim rs As New ADODB.Recordset

    'エクセルエクスポート定義
    Dim objApp As Object
    Dim objWkb As Object
    Dim objWsh As Object

    '書出しCellsの定義
    Dim SCol As Integer
    Dim SRow As Integer
  
    '書出しCell位置
    SRow = 6  '行
    SCol = 3  '行
  
     '出力先のエクセルを利用できるように設定
     Set objApp = CreateObject("Excel.Application")
   
     'エクセルのパスを指定
     Set objWkb = objApp.Workbooks.Open("出力先のパス")
  
    'Sheet名を指定
     Set objWsh = objWkb.Worksheets("Sheet1")
  
    ''''''''''''''''''''''''''''''''''''''''''''''''''
    '書出し
    ''''''''''''''''''''''''''''''''''''''''''''''''''
  
    '書出しCell位置
    SRow = 1
    SCol = 1
  
    MySQL = "SELECT 日付, 開始,終了 FROM T_データ ORDER BY 日付"
  
    rs.Open MySQL, CurrentProject.Connection

    

    '取得したデータ起点のCellsから個別に出力
    Do Until rs.EOF
        objWsh.Cells(SRow, SCol).Value = rs!日付.Value
        objWsh.Cells(SRow, SCol + 1).Value = rs!開始.Value
        objWsh.Cells(SRow, SCol + 2).Value = rs!終了.Value
        
        '相対参照用の数式
        objWsh.Cells(SRow, SCol + 3).Value = "=" & "C" & SRow & "-B" & SRow

        '書式設定
        objWsh.Cells(SRow, SCol + 3).NumberFormatLocal = "h:mm;@"
        
        
        
        SRow = SRow + 1
        rs.MoveNext
   Loop
  
    rs.Close
    Set rs = Nothing
  
  '保存
  objWkb.Save
  objWkb.Close
  objApp.Quit

  'Excel Close処理
  Set objApp = Nothing
  Set objWkb = Nothing
  Set objWsh = Nothing
 
  MsgBox "完了。"

End Sub