[thanosgr]

Καλημέρα εχω ενα πρόβλημα..
θέλω να κανω εισαγωγή κελιών μεσα απο την access σε ενα αρχειο excel.
Εχω ενα προτυπο αρχειο, με κελια με εγγραφες που τραβαει απο την Access

το αρχειο ειναι φτιαγμενο για 4 περιπου εγγραφες. και θέλω εάν ειναι παραπάνω απο 4 για να μην μου χαλάει το κείμενο που εχω κατω απο τα κελιά με τις εγγραφες να κανει insert.

το προβλημα ειναι οτι περναει τις εγγραφε΄ς στα υπολοιπα κελιά, αλλα πηδάει τα κελια που εχω απλως ενα κείμενο. Ουσιαστικά θελω το κειμενο να κανει shiftdown και εαν ειναι δυνατο να κραταει και το format των προηγούμενων κελιων.


Private Sub btnExcelExport_Click()

'We'll start by creating a recordset named rstexcel.
Dim rstexcel As DAO.Recordset
Dim lngCount, lnginsert As Long

'Build the SQL statement (swiped from a query).
Dim MySQL As String


MySQL = "SELECT PreorderDetails.PreorderDetailDescription,Preorder .approvaltext1, Preorder.Approved,PreorderDetails.Price,Preorderde tails.quantity, Preorderdetails.uom"
MySQL = MySQL & " FROM Preorder INNER JOIN PreorderDetails ON Preorder.PreorderID = PreorderDetails.PreorderID "
MySQL = MySQL & " WHERE Preorder.PreorderID =" & Me!PreorderID & " and preorder.approved=true"



Set rstexcel = CurrentDb.OpenRecordset(MySQL, dbOpenForwardOnly)


'Now rstexcel contains records to be exported.

'Now for the Excel rigmarole.
'Define the path to the workbook, save it as MySheetPath.
Dim MySheetPath As String
'Note: You must change the path and filename below
'to an actual Excel .xlsx file on your own computer.
MySheetPath = "E:\ACCESS DATABASE\sxedio2.xls"

'Set up object variables to refer to Excel and objects.
Dim Xl As Excel.Application
Dim XlBook As Excel.Workbook
Dim XlSheet As Excel.Worksheet

'Open an instance of Excel, open the workbook.
Set Xl = CreateObject("Excel.Application")
Set XlBook = GetObject(MySheetPath)

'Make sure everything is visible on the screen.
Xl.Visible = True
XlBook.Windows(1).Visible = True

'Define the topmost sheet in the Workbook as XLSheet,
Set XlSheet = XlBook.Worksheets(1)
lngCount = 16
lnginsert = 20
With rstexcel
XlSheet.Range("c10") = rstexcel("approvaltext1")
Do Until .EOF
If rstexcel.RecordCount > 4 Then

XlSheet.Range("A" & lnginsert).Insert (xlShiftDown)
lnginsert = lnginsert + 1
End If

XlSheet.Range("C" & lngCount) = rstexcel("PreorderDetailDescription")

If rstexcel!UOM = "temaxia" Then
XlSheet.Range("D" & lngCount) = rstexcel("Quantity")
Else
XlSheet.Range("E" & lngCount) = rstexcel("Quantity")
End If

XlSheet.Range("H" & lngCount) = rstexcel("Price")
.MoveNext

Loop

End With

'Clean up and end with worksheet visible on the screen.
rstexcel.Close
Set rstexcel = Nothing

Set Xl = Nothing
Set XlBook = Nothing
Set XlSheet = Nothing


End Sub


Ευχαριστώ