กระทู้เก่าบอร์ด อ.สุภาพ ไชยา
290 1
URL.หัวข้อ /
URL
Adding additional Excel Row during Export
ถามไว้ที่
http://www.utteraccess.com/forums/showflat.php?Cat=&Board=access_2000&Number=120114&page=0&view=&sb=&o=&fpart=1&vc=1&PHPSESSID=
มีไฟล์ที่ส่งออกจาก Access ไปยัง Excel แต่ต้องการที่จะแทรก 2 แถวไว้ข้างบนในไฟล์ Excel และ แทรกอีก 1 แถวที่อยู่ด้านล่างสุด จะทำได้อย่างไร
ผมเลยให้โค้ดเขาไปดังนี้ครับ
Sub Insert2Rows()
Dim xlApp As Object
Dim Sheet As Object
Dim strAppPath As String
Dim xlLastCell As Long, strRange As String
Dim Row As Long, Col As Integer
strAppPath = "h:\workfile\mdb\97\ExportwRow.xls"
Set xlApp = CreateObject("Excel.Application")
Set Sheet = xlApp.Workbooks.Open(strAppPath).Sheets(1)
xlApp.Visible = True
' Insert 2 rows on the top and move existing rows down
xlApp.Rows("1:2").SELECT
xlApp.Selection.Insert Shift:=-4121 'xlDown
xlLastCell = 11 ' xlLastCell in Excell equals 11
With Sheet
Row = .Cells.SpecialCells(xlLastCell).Row
.Range("A" & Row + 1).SELECT
xlApp.ActiveCell.FormulaR1C1 = "This is the last row"
End With
' Stop to see the result
MsgBox "Do you want to exit Excel now?"
' Close workbook without saving.
xlApp.ActiveWorkbook.Saved = True
xlApp.ActiveWorkbook.Close
Set Sheet = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
http://www.utteraccess.com/forums/showflat.php?Cat=&Board=access_2000&Number=120114&page=0&view=&sb=&o=&fpart=1&vc=1&PHPSESSID=
มีไฟล์ที่ส่งออกจาก Access ไปยัง Excel แต่ต้องการที่จะแทรก 2 แถวไว้ข้างบนในไฟล์ Excel และ แทรกอีก 1 แถวที่อยู่ด้านล่างสุด จะทำได้อย่างไร
ผมเลยให้โค้ดเขาไปดังนี้ครับ
Sub Insert2Rows()
Dim xlApp As Object
Dim Sheet As Object
Dim strAppPath As String
Dim xlLastCell As Long, strRange As String
Dim Row As Long, Col As Integer
strAppPath = "h:\workfile\mdb\97\ExportwRow.xls"
Set xlApp = CreateObject("Excel.Application")
Set Sheet = xlApp.Workbooks.Open(strAppPath).Sheets(1)
xlApp.Visible = True
' Insert 2 rows on the top and move existing rows down
xlApp.Rows("1:2").SELECT
xlApp.Selection.Insert Shift:=-4121 'xlDown
xlLastCell = 11 ' xlLastCell in Excell equals 11
With Sheet
Row = .Cells.SpecialCells(xlLastCell).Row
.Range("A" & Row + 1).SELECT
xlApp.ActiveCell.FormulaR1C1 = "This is the last row"
End With
' Stop to see the result
MsgBox "Do you want to exit Excel now?"
' Close workbook without saving.
xlApp.ActiveWorkbook.Saved = True
xlApp.ActiveWorkbook.Close
Set Sheet = Nothing
xlApp.Quit
Set xlApp = Nothing
End Sub
1 Reply in this Topic. Dispaly 1 pages and you are on page number 1
1 @R06595
Time: 0.1312s