Excel Insert
 

Καλημέρα εχω ενα πρόβλημα..
θέλω να κανω εισαγωγή κελιών μεσα απο την 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


Ευχαριστώ

Καλημέρα Θάνο!

Ο κώδικας όπως παρουσιάζεται έχει κάποια λαθάκια αλλά δεν θα πρέπει να σε απασχολεί αφού υπάρχει πιο απλή λύση χρησιμοποιώντας τη μέθοδο εισαγωγής δεδομένων Access στην Excel από την επιφάνεια εργασίας του Excel.

Όποια μέθοδο όμως και αν τελικά επιλέξεις, θα πρέπει να μας ανεβάσεις τα 2 αρχεία που προανέφερες με παραδειγματικές εγγραφές για να μπορέσουμε να σε βοηθήσουμε.

Με εκτίμηση

Τάσος

Οκ ευχαριστώ ανέβασα το αρχείο

Ναι έχει κάποια λαθάκια
κατω απο το .movenext
lngCount=lngCount+1

ξεχασα να βάλω τον μετρηρή. Πάντως για τις πρώτες 4 εγγραφές δουλεύει. Θέλω με το που φτάνει στο σύνολο να προσθέτει τα κελιά και να εισάγει τις επόμενες εγγραφές. Αυτο που κάνει τώρα ειναι ,εισάγει τις νέες εγγραφες όπου βρίσκει υπάρχον κείμενο, το παρακάμπτει, και γράφει στα επόμενα κελια, πχ τεχνικες προδιαγραφές

Ευχαριστώ

ΥΣ:Τον κώδικα τον βρήκα απο βιβλίο αλλα δεν ειχε σχετικά με το insert παρα μόνο απο το help της VBA αλλα δεν ειχε καλό παράδειγμα

Καλημέρα Θάνο!

Δοκίμασε τον παρακάτω κώδικα.

Δεν έχω την δυνατότητα να τον δοκιμάσω αφού δεν έχω την αντίστοιχη βάση δεδομένων.

Αν υπάρξει κάποιο πρόβλημα θα πρέπει να μας ανεβάσεις όπως είχαμε πει και ένα παράδειγμα της βάσης σου.


Με εκτίμηση

Τάσος

Τάσο Ευχαριστώ
rHeight = .RowHeight
method or data member not found.

Οκ το διόρθωσα το πρόβλημα βλεπω εκτελεί αλλά δεν μου ανοίγει το excel

Θάνο δεν με βοηθάς καθόλου:001_smile:.

Θα έπρεπε να ανεβάσεις ένα αρχείο Access για να βλέπουμε τι κάνουμε και να μην δίνουμε άστοχες απαντήσεις.

Μπορείς να δοκιμάσεις τον τροποποιημένο κώδικα στο προηγούμενο μήνυμα μου.

Τάσος

Τάσο ευχαριστώ
δουλεύει, απλως ηθελε να βάλω xl as excel.applcation και να το κάνω visible μπροστά στα μάτια μου ήτανε :)

Ευχαριστώ

Να είσαι καλά Θάνο!

Καλή συνέχεια!

Γειά σου Τάσο εκανα κατι αλλαγές στο excel αρχειο, δουλευει αλλα πάνω απο τις 10 εγγραφές που το έχω βάλει μου κάνεi De-Merge τα κελιά
Θέλει κάποια αλλαγή στον κωδικα αλλα δεν γνωρίζω

Αυτο είναι βασισμένο στον δικό σου κώδικα

2) Μπορείς να δείς γιατί δεν μου ανοίγει αυτόματα το Excel? αλλα θα πρέπει να γίνει χειροκίνητα το άνοιγμα του Excel για να περάσει τις εγγραφές?

Ευχαριστώ
Θάνος