hiroton
2022/07/21 (木) 08:38:49
0ef9f@f966d
こうしてみたらどうでしょう?
Dim sql As String: sql = ""
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim fn As String: fn = ""
Dim template_fn As String: template_fn = "ファイル名"
Dim tf_path As String: tf_path = CurrentProject.Path & "\" & template_fn & ".xlsx"
Dim xl_app As Object
Dim line_no As Long: line_no = 4
sql = ""
sql = sql & "SELECT A,B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U "
sql = sql & "FROM T_TEST "
Set rs = New ADODB.Recordset
Set cn = CurrentProject.Connection
rs.Open sql, cn, adOpenStatic, adLockReadOnly
Set xl_app = CreateObject("Excel.Application")
xl_app.Visible = False '可視設定
With xl_app
If Dir(tf_path) = "" Then
MsgBox "ファイルなし"
.Quit
Exit Sub
End If
'// .Workbooks.Open tf_path
With .Workbooks.Open(tf_path)
With .Activesheet
Do Until rs.EOF
'書式入り行コピー
.Rows(line_no & ":" & line_no).Select
.Selection.Copy
.Rows(line_no & ":" & line_no + 1).Select
'// .Activesheet.Paste
.Paste
.Application.CutCopyMode = False
.cells(line_no, 1) = rs!A 'ここでエラー
.cells(line_no, 2) = rs!B
.cells(line_no, 3) = rs!c
.cells(line_no, 4) = rs!d
.cells(line_no, 5) = rs!E
.cells(line_no, 6) = rs!f
.cells(line_no, 7) = rs!G
.cells(line_no, 8) = rs!H
.cells(line_no, 9) = rs!i
.cells(line_no, 10) = rs!j
.cells(line_no, 11) = rs!K
.cells(line_no, 12) = rs!L
.cells(line_no, 13) = rs!M
.cells(line_no, 14) = rs!n
.cells(line_no, 15) = rs!O
.cells(line_no, 16) = rs!P
.cells(line_no, 17) = rs!Q
.cells(line_no, 18) = rs!R
.cells(line_no, 19) = rs!s
.cells(line_no, 20) = rs!T
.cells(line_no, 21) = rs!u
line_no = line_no + 1
rs.MoveNext
Loop
.Rows(line_no & ":" & line_no).Delete
.Range("A1").Select
.Visible = True
End With
End With
End With
rs.Close
※コードの善し悪しは評価していません
Excel処理の問題のようなので、この掲示板(ACCESS掲示板)よりもExcelに強い場所で質問するとうまく解決できるかもしれませんね
通報 ...