access2010 モジュールで excel各シートの最後に集計をしたい

お世話になります。
　
　ネットでいろいろ調べながらaccessの勉強をしております。
　なかなか難しくて、質問せずには、自分の力ではどうしても進まなくなりました。
　どうか教えて頂けますよう、よろしくお願いいたします。


下記のように、モジュールで作りました。
会社別にexcelシートを分けてます。
１）各シートの最初に、accessのフィールドを出したいです。
２）各シートの最後に集計を出したいです。


よろしくお願いします。

----------------------------------------------------
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓モジュール↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
----------------------------------------------------

Option Compare Database

Function SheetWrite()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim objXLS As Object
Dim wstXLS As Excel.Worksheet 'エクセル ワークシート
Dim rngXLS As Excel.Range 'エクセル 全範囲

Dim mydb As DAO.Database
Dim myrs As DAO.Recordset
Dim varData As Variant
Dim mySQL As Variant

'テーブル削除用変数などを定義します。
Dim strSQL As String 'SQL文格納用

DoCmd.SetWarnings False '警告を無効にします。-----A

'tbl_groupテーブルを作成します。
DoCmd.RunSQL "SELECT [出荷先] INTO [tbl_group] FROM [tbl_sample] GROUP BY [出荷先];"

Set mydb = CurrentDb()
Set myrs = mydb.OpenRecordset("tbl_group", dbOpenTable)

'出力先のExcelを利用できるように設定します。
Set objXLS = Excel.Application
'新しいブックを作成します。
objXLS.Workbooks.Add '-----B

Do Until myrs.EOF

varData = myrs!出荷先 '-----C

mySQL = "SELECT 出荷日, 商品名, 商品名2, 数量, 単価, 金額 "
mySQL = mySQL & "FROM tbl_sample WHERE 出荷先 = '" & varData & "';" '-----D

Set db = CurrentDb
Set rs = db.OpenRecordset(mySQL)
Set wstXLS = Worksheets.Add 'ワークシートを追加します。
wstXLS.Name = varData 'ワークシート名を命名します。

'以下-----E
Set rngXLS = wstXLS.Range(Cells(2, 1), _
Cells(rs.RecordCount + 1, rs.Fields.Count))
rngXLS.CopyFromRecordset rs 'Excelにデータを書き込みます。

myrs.MoveNext

Loop
'以下-----F
objXLS.Visible = True
ActiveWorkbook.SaveAs ("C:\Users\****\Desktop\temp.xls")

DoCmd.SetWarnings True '警告を有効に戻します。


Set rs = Nothing
Set db = Nothing
Set objXLS = Nothing
Set wstXLS = Nothing
Set rngXLS = Nothing
Set mydb = Nothing
Set myrs = Nothing



'データベースを現在のMDBファイルに設定します。
Set daoDB = CurrentDb

'削除用のSQL文1を作成します。
'テーブルを削除
strSQL = "Delete * From 出荷システム"

daoDB.Execute strSQL

'作成したSQL文を実行します。
daoDB.Execute strSQL



'削除用のSQL文2を作成します。
'テーブルを削除
strSQL = "Delete * From tbl_sample"

daoDB.Execute strSQL

'作成したSQL文を実行します。
daoDB.Execute strSQL




'削除用のSQL文3を作成します。
'テーブルを削除
strSQL = "Delete * From tbl_group"

daoDB.Execute strSQL

'作成したSQL文を実行します。
daoDB.Execute strSQL



'データベースを解放します。
Set daoDB = Nothing

End Function

No.3 回答者： xMAKISHIx 回答日時： 2015/11/16 17:08

もし不具合やこういう風に変更したい等ありましたらまたご連絡下さい。

No.2 回答者： xMAKISHIx 回答日時： 2015/11/16 09:46

lngTotal = lngTotal + objRS!金額は消してください。

そして、
objWorkBook.Activesheet.Cells(lngRow, 6).Value = lngTotal
を
objWorkBook.Activesheet.Cells(lngRow, 6).Value = "=SUM(F2:F" & lngRow - 1 & ")"
に書き換えて見てください。

この回答へのお礼

ありがとうございます！
できました！！！
感激です！！！
また何かありましたら、教えてください！！！
本当に助かりました。ｍ(_ _)ｍ

お礼日時：2015/11/16 15:58

No.1 回答者： xMAKISHIx 回答日時： 2015/11/12 17:03

Option Compare Database

Option Explicit

Private objDB As DAO.Database
Private objExcel As Object 'EXCELオブジェクト
Private objWorkBook As Object 'WORKBOOKオブジェクト
Private objSheet As Object 'SHEETオブジェクト

Private Sub SheetWrite()

　　Dim SyukkaRS As DAO.Recordset
　　Dim objRS As DAO.Recordset
　　Dim mySQL As String
　　Dim lngRow As Long
　　Dim lngCol As Long
　　Dim lngLoopCt As Long
　　Dim lngTotal As Long

　　Set objDB = CurrentDb

　　DoCmd.SetWarnings False '警告を無効にします。-----A

　　'tbl_groupテーブルを作成します。
　　DoCmd.RunSQL "SELECT [出荷先] INTO [tbl_group] FROM [tbl_sample] GROUP BY [出荷先];"

　　Set SyukkaRS = objDB.OpenRecordset("tbl_group", dbOpenTable)

　　'出力先のExcelを利用できるように設定します。
　　Set objExcel = CreateObject("Excel.Application")
　　'新しいブックを作成します。
　　objExcel.Visible = True
　　Set objWorkBook = objExcel.Workbooks.Add '-----B

　　Do Until SyukkaRS.EOF

　　　　mySQL = "SELECT 出荷日, 商品名, 商品名2, 数量, 単価, 金額 "
　　　　mySQL = mySQL & "FROM tbl_sample WHERE 出荷先 = '" & SyukkaRS!出荷先 & "'" '-----D

　　　　Set objRS = objDB.OpenRecordset(mySQL)
　　　　objWorkBook.Activesheet.Name = SyukkaRS!出荷先

　　　　For lngCol = 1 To objRS.Fields.Count
　　　　　　objWorkBook.Activesheet.Cells(1, lngCol).Value = objRS.Fields(lngCol - 1).Name
　　　　Next

　　　　lngRow = 2
　　　　lngTotal = 0
　　　　Do Until objRS.EOF

　　　　　　objWorkBook.Activesheet.Cells(lngRow, 1).Value = objRS!出荷日
　　　　　　objWorkBook.Activesheet.Cells(lngRow, 1).NumberFormatLocal = "yyyy/mm/dd"
　　　　　　objWorkBook.Activesheet.Cells(lngRow, 2).Value = objRS!商品名
　　　　　　objWorkBook.Activesheet.Cells(lngRow, 3).Value = objRS!商品名2
　　　　　　objWorkBook.Activesheet.Cells(lngRow, 4).Value = objRS!数量
　　　　　　objWorkBook.Activesheet.Cells(lngRow, 5).Value = objRS!単価
　　　　　　objWorkBook.Activesheet.Cells(lngRow, 6).Value = objRS!金額
　　　　　　lngTotal = lngTotal + objRS!金額

　　　　　　lngRow = lngRow + 1
　　　　　　objRS.MoveNext

　　　　Loop

　　　　objWorkBook.Activesheet.Cells(lngRow, 3).Value = "（合計）"
　　　　objWorkBook.Activesheet.Cells(lngRow, 6).Value = lngTotal

　　　　If lngLoopCt < SyukkaRS.RecordCount - 1 Then
　　　　　　objWorkBook.Sheets.Add After:=objWorkBook.WorkSheets(objWorkBook.WorkSheets.Count)
　　　　End If

　　　　lngLoopCt = lngLoopCt + 1
　　　　SyukkaRS.MoveNext

　　Loop

　　'以下-----F
　　objExcel.Application.DisplayAlerts = False
　　Call objWorkBook.SaveAs("C:\Users\egmaingx\Desktop\temp.xlsx")
　　objExcel.Application.DisplayAlerts = True

　　DoCmd.SetWarnings True '警告を有効に戻します。

　　Set objRS = Nothing
　　Set objDB = Nothing

　　'削除用のSQL文1を作成します。
　　'テーブルを削除
　　mySQL = ""
　　mySQL = "Delete * From 出荷システム"

　　objDB.Execute mySQL

　　'作成したSQL文を実行します。
　　objDB.Execute mySQL

　　'削除用のSQL文2を作成します。
　　'テーブルを削除
　　mySQL = ""
　　mySQL = "Delete * From tbl_sample"

　　objDB.Execute mySQL

　　'作成したSQL文を実行します。
　　objDB.Execute mySQL

　　'削除用のSQL文3を作成します。
　　'テーブルを削除
　　mySQL = ""
　　mySQL = "Delete * From tbl_group"

　　objDB.Execute mySQL

　　'作成したSQL文を実行します。
　　objDB.Execute mySQL

　　'データベースを解放します。
　　Set objDB = Nothing

End Sub

こんな感じでどうでしょうか？
参照設定は端末によって変わってしまうのでやめました。

この回答へのお礼

できました！
早速の対応ありがとうございます！
本当に助かりました！

ただ、合計金額のところですが、
できれば関数を残した状態で、金額を表示できるようにしたいですが。。。

見た目は数字ですが、excelのセールを選択すると、下記の関数が出るようにしたいです。

例：　=SUM(F2:F59)

よろしくお願い致します。ｍ(_ _)ｍ

お礼日時：2015/11/13 11:09