| |
▼Saiyama さん、Gin_II さん：
こんばんは。
Excel 側で操作をしてみました。
Sub 標題を20行毎にExcelに主力()
'要参照 Microsoft DAO x.x Object Library
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsSht As Object
Dim xName As String
Dim RS As DAO.Recordset
Dim QName As String
Dim i As Long
Dim j As Long
Dim LastRow As Long
Const lngMaxRow As Long = 20
xName = "C:\Test2.xls"
On Error Resume Next
Kill xName
On Error GoTo 0
QName = "クエリ名"
LastRow = DCount("*", QName)
Set RS = CurrentDb.OpenRecordset(QName, dbOpenSnapshot)
Set xlsApp = CreateObject("Excel.Application")
'xlsApp.Visible = True
Set xlsWkb = xlsApp.Workbooks.Add
With xlsWkb.Sheets("Sheet1")
Do Until RS.EOF
For i = 0 To RS.Fields.Count - 1
.Cells(j * (lngMaxRow + 1) + 1, i + 1).Value = RS(i).Name
Next
.Cells(j * (lngMaxRow + 1) + 2, 1).CopyFromRecordset RS, lngMaxRow
j = j + 1
Loop
End With
RS.Close: Set RS = Nothing
xlsWkb.SaveAs xName
xlsWkb.Close True: Set xlsWkb = Nothing
xlsApp.Quit: Set xlsApp = Nothing
MsgBox "エクスポート終了"
End Sub
ExcelVBA を使っていますので理解出来ない所もあるかとは思いますが、
解らない事がありましたら遠慮せずに質問なさって下さい。
|
|
小僧
- 05/10/25(火) 17:51 -
