| |
アクセスで作成したテーブルの内容をエクセルに転記したく
コードを作製したのですが i= のところで
アプリケーション定義または〜とエラーが出てしまいます
一行ずつ実行するとiの部分が０のまま変わらず最終行を示さないようです
エクセルは1行目にオーダーNOとかが入っています
データが無い行から追加していくようにしたいのですが
うまくいきません
End(2)とすると2行目から追記していくので全体的には
あっているとおもうのですが
Private Sub コマンドMC_Click()
On Error GoTo Err_コマンドMC_Click
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim appExcel As Object
Dim Worksheets As Object
Dim i As Integer
Set DB = CurrentDb
Set RS = CurrentDb.OpenRecordset("照合一覧")
Set appExcel = GetObject("\\192.168.3.199\管理\受注管理\日程管理表.xls")
Set Worksheets = appExcel.Worksheets("加工未定") 'ワークシート名
appExcel.Parent.Windows(appExcel.Name).Visible = False
With Worksheets
i = .Range("A1").End(xlDown).Row + 1 ・・・ここでエラー
RS.MoveFirst
Do Until RS.EOF = True
.Cells(i, 1) = RS.Fields("オーダーNo")
.Cells(i, 2) = RS.Fields("品番図番")
.Cells(i, 3) = RS.Fields("品名")
'.Cells(i, 4) = RS.Fields(" ")
.Cells(i, 5) = RS.Fields("発注残数")
.Cells(i, 6) = RS.Fields("納期")
RS.MoveNext
i = i + 1
Loop
.Cells.Columns.AutoFit
.Range("F:F").NumberFormatLocal = "MM/DD"
.Range("A:A").NumberFormatLocal = "@"
End With
appExcel.Parent.Windows(appExcel.Name).Visible = True
appExcel.Close True
Set Worksheets = Nothing
Set appExcel = Nothing
MsgBox ("エクセルへの出力が終了しました")
Exit_コマンドMC_Click:
Exit Sub
Err_コマンドMC_Click:
MsgBox Err.Description
Resume Exit_コマンドMC_Click
End Sub
|
|
![[未読]](./data/access/image/read_icon.gif){kind=icon}
