ACCESSのVBAにてＥｘｃｅｌに行を追加したい

Excelのシートは、見出しを固定にし、表があり、最後に合計となっています。
複数ページにまたがる場合は、最後のページに合計を印刷するので、データが表をオーバーする場合、行の挿入を行いたいのです。
方法はありますでしょうか？

No.3 ベストアンサー 回答者： PAPA0427 回答日時： 2004/01/09 16:57

Selection.Insert Shift:=xlDown

の部分を
Ws.Rows("2:2").Insert Shift:=xlDown
と変更してください。

動作確認はしました。

この回答へのお礼

出来ました！
本当にありがとうございました。

お礼日時：2004/01/09 17:43

No.2 回答者： PAPA0427 回答日時： 2004/01/09 15:46

検証しませんが、おそらく動作すると思います。

Private Function Excel_Out(WorkTable As String) As Boolean
　　Dim Ex As Excel.Application 'エクセルリンク用変数（App）
　　Dim Wb As Excel.Workbook 'エクセルリンク用変数（App）
　　Dim Ws As Excel.Worksheet 'エクセルリンク用変数（App）
　　Dim Cnt As Long
　　Dim PageCnt As Long
　　Dim strSQL As String
　　Dim oRs As Recordset
　　Dim RecCnt As Long
　　Dim i As Long
　　Dim FileName As String
　　Dim FileNameS As String


　　On Error GoTo Excel_Out_Err

　　FileName = "C:TEST_MOTO.xls"
　　FileNameS = "C:\TEST.xls"
　　Excel_Out = False

　　DoCmd.Hourglass True

　　'エクセルシートオープン
　　Set Ex = New Excel.Application
　　Set Wb = Ex.Workbooks.Open(FileName)
　　Ex.DisplayAlerts = False
　　Set Ws = Wb.Worksheets("Sheet1")

　　'ワークテーブルのオープン
　　strSQL = ""
　　strSQL = strSQL & "Select * From " & WorkTable
　　Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
　　RecCnt = oRS.RecordCount
　　
　　InsCnt = RecCnt - X ←ここでインサートに必要な行数を計算してください。
　　for i = 1 to InsCnt
　　　　Ws.Rows("2:2").Select ←インサート行う位置の指定です。
　　　　Selection.Insert Shift:=xlDown
　　Next i
　　
　　Do Until oRs.EOF
　　　　Cnt = Cnt + 1
　　　　Ws.Cells(Cnt, 1) = oRs.Fields("A").Value
　　　　Ws.Cells(Cnt, 2) = oRs.Fields("B").Value
　　　　Ws.Cells(Cnt, 3) = oRs.Fields("C").Value
　　　　　　・
　　　　　　・
　　　　　　・
　　　　oRs.MoveNext
　　Loop
　　oRs.Close
　　Set oRs = Nothing

　　Wb.SaveAs FileNameS
　　Ex.DisplayAlerts = True
　　Wb.Close
　　Ex.Quit
　　Set Ws = Nothing
　　Set Wb = Nothing
　　Set Ex = Nothing
　　
　　Excel_Out = True
　　Exit Function
Excel_Out_Err:
　　Excel_Out = False
End Function

この回答への補足

回答ありがとうございます。
早速実行してみましたが、
Selection.Insert Shift:=xlDown
のところで、
実行時エラー'424'
オブジェクトが必要です
のメッセージが表示されます。
ここは、そのまま代用したのですが、何か変更するところがあったのでしょうか？
オブジェクトはどこに、どのオブジェクトをつけたらいいのでしょうか？
Selectionの前に、ワークシートのオブジェクトをつけてみましたが、
実行時エラー'438'
オブジェクトはこのプロパティまたはメソッドをサポートしていません。
のメッセージが表示されました。

補足日時：2004/01/09 16:44

No.1 回答者： PAPA0427 回答日時： 2004/01/09 10:13

モデファイして、お使いください。

Private Function Excel_Out(WorkTable As String) As Boolean
　　Dim Ex As Excel.Application 'エクセルリンク用変数（App）
　　Dim Wb As Excel.Workbook 'エクセルリンク用変数（App）
　　Dim Ws As Excel.Worksheet 'エクセルリンク用変数（App）
　　Dim Cnt As Long
　　Dim PageCnt As Long
　　Dim strSQL As String
　　Dim oRs As Recordset
　　Dim FileName As String
　　Dim FileNameS As String


　　On Error GoTo Excel_Out_Err

　　FileName = "C:TEST_MOTO.xls"
　　FileNameS = "C:\TEST.xls"
　　Excel_Out = False

　　DoCmd.Hourglass True

　　'エクセルシートオープン
　　Set Ex = New Excel.Application
　　Set Wb = Ex.Workbooks.Open(FileName)
　　Ex.DisplayAlerts = False
　　Set Ws = Wb.Worksheets("Sheet1")

　　'ワークテーブルのオープン
　　strSQL = ""
　　strSQL = strSQL & "Select * From " & WorkTable
　　Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

　　Do Until oRs.EOF
　　　　Cnt = Cnt + 1
　　　　Ws.Cells(Cnt, 1) = oRs.Fields("A").Value
　　　　Ws.Cells(Cnt, 2) = oRs.Fields("B").Value
　　　　Ws.Cells(Cnt, 3) = oRs.Fields("C").Value
　　　　　　・
　　　　　　・
　　　　　　・
　　　　oRs.MoveNext
　　Loop
　　oRs.Close
　　Set oRs = Nothing
　　Cnt = Cnt + 1
　　Ws.Cells(Cnt, 1) = "=SUM(A1:A" & Cnt & ")"
　　Ws.Cells(Cnt, 2) = "=SUM(B1:B" & Cnt & ")"
　　Ws.Cells(Cnt, 3) = "=SUM(C1:C" & Cnt & ")"
　　　　・
　　　　・
　　　　・
　　Wb.SaveAs FileNameS
　　Ex.DisplayAlerts = True
　　Wb.Close
　　Ex.Quit
　　Set Ws = Nothing
　　Set Wb = Nothing
　　Set Ex = Nothing
　　
　　Excel_Out = True
　　Exit Function
Excel_Out_Err:
　　Excel_Out = False
End Function

この回答への補足

回答ありがとうございます。
私の説明が下手ですいません。
Ｅｘｃｅｌのシートにはレイアウトが設定してあるために、それを生かしてつくりたいと思っています。
データをＥｘｃｅｌに書き込むところまでは、出来ているのですが、行数が超えた場合に、現状では合計の行を上書きしてしまっています。
表の最後と合計との間にデータを追加したいのです。
１命令で行の挿入とかってできないのでしょうか？
ＥｘｃｅｌのＶＢＡには行の挿入がありますよね？
ACCESSのＶＢＡからＥｘｃｅｌのＶＢＡを呼び出すとかも出来ないのでしょうか？

補足日時：2004/01/09 12:31