Εκτύπωση πίνακα με VBA
 

Καλησπέρα.

Έχω δυο βασικά προβλήματα

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

2. Θέλω να κάνω εκτύπωση μέσω κώδικα.. το είχα φτιάξει παλιά και δούλευε αλλά το διέγραψα γιατί εκτύπωνα με Report και τώρα δεν μπορώ να το ξαναφτιάξω..

Σας ευχαριστώ εκ των προτέρων

Καλησπέρα Γιώργο,

Καλώς ήρθες στο Forum και σου στέλνω τις απαντήσεις σου στο ερώτημά σου.

Public Sub ViewRecordPerField(ByVal TblName As String)

'Απαιτήσεις είναι στα Reference το Microsoft DAO 3.6 Object Library

'Παράδειγμα κλήσης ViewRecordPerField("TblItems")

Dim Fld As Object, IntTabInd As String, Tbl As TableDef, Dbs As Database, RcdSetTable As DAO.Recordset

Set Dbs = CurrentDb

Set Tbl = Dbs.TableDefs(TblName)

Set RcdSetTable = Dbs.OpenRecordset("Select * From " & TblName)

If Not RcdSetTable.EOF And Not RcdSetTable.BOF Then

    RcdSetTable.MoveFirst

        Do While Not RcdSetTable.EOF

            For Each Fld In Tbl.Fields

                Debug.Print RcdSetTable.Fields(Fld.Name).Value

            Next Fld

            RcdSetTable.MoveNext

        Loop

End If

End Sub



Function PrintObject(ByVal RptName As String)

'Κλήση του Print Dialog

'Παράδειγμα PrintObject("RptItems")

On Error Resume Next

    Application.Echo False

        DoCmd.OpenReport RptName, acViewPreview

            DoCmd.RunCommand acCmdPrint

        DoCmd.Close acReport, RptName

    Application.Echo True

End Function

Κωστα σε ευχαριστώ πολύ αλλα απο δική μου παράληψη δεν σου το εθεσα σωστά... σου ξαναστέλνω το ερώτημα ως αφορά την ερώτηση "οριζοντια" και ένα κώδικα που εφτιαξα παλιά για εκτύπωση με κώδικα...

Υ.Γ εκτύπωση κατευθείαν στον εκτυπωτή και οχι σε text

2) Υ.Γ μπορείς να μου πεις κώστα εάν μπορώ να βάλω και WHERE στον πρώτο κώδικα που μου έστειλες?

WHERE είτε με αναζήτηση στο όνομα του πεδίου, είτε με αναζήτηση στα δεδομένα που έχει το πεδίο...

πχ. όνομα πεδίου "Pelates" WHERE Pelates = ....!!!!
ή Στοιχειο καταχωρημένο στο πεδίο "ΠΑΠΑΔΟΠΟΥΛΟΣ" WHERE Pelates = " & ΠΑΠΑΔΟΠΟΥΛΟΣ

Μετατρέποντας ελαφρά τον κώδικα για το Where και βάζοντας μόνο το ID του πελάτη ας υποθέσουμε πως ονομάζεται CustomerID και όχι Name (Επίθετο έχουμε)

Στην κλήση της συνάρτησης αντί ρουτίνας που ήταν προστήθεται και το ID του πελάτη που θέλουμε να καλέσουμε.

Public Function ViewRecordPerField(ByVal TblName As String, CustID As Variant)

'Απαιτήσεις είναι στα Reference το Microsoft DAO 3.6 Object Library

'Παράδειγμα κλήσης ViewRecordPerField("TblItems")

Dim Fld As Object, Tbl As TableDef, RcdSetTable As DAO.Recordset, TempTxt as String

Set Tbl = CurrentDb.TableDefs(TblName)

Set RcdSetTable = Dbs.OpenRecordset("Select * From " & TblName & " Where AccEidosCode=" & CustID)

If Not RcdSetTable.EOF And Not RcdSetTable.BOF Then

            For Each Fld In Tbl.Fields

                TempTxt=TempTxt &  Fld & vblf

            Next

'Καλούμε το PrintTemp

 PrintTemp "tmp.txt", TempTxt 

End If

End Function



Function PrintTemp(tmpName$, oText$) ' Όνομα ή και διαδρομή αρχείου, κείμενο που θα εκτυπωθεί.

Dim fso As Object, oStream As Object, oWs As Object

Set oStream = fso.CreateTextFile(tmpName, True, True)

oStream.Write oText

oStream.Close

  Set oWs = CreateObject("WScript.Shell")

  oWs.Run "NotePad.exe /p tmpName"

End Function

kωστα καλημερα.. 8ελω να επικοινωνησω μαζι σου τηλεφωνικά εάν μπορείς.. σου στέλνω το e-mail μου Kapsalis_Giorgos παπάκι windowslive.com εαν θες στείλε μου το τηλ. σου και τη ώρες μπορείς να σε καλεσω.

Σε Ευχαριστώ.

Edit από Admin: Αλλαγή του E-Mail προς αποφυγή SPAM.
Παρακαλώ, χρησιμοποιείτε τα προσωπικά μηνύματα για ιδιωτικές συνομιλίες.

Αγαπητέ φίλε Γιώργο,

Στο Forum θα πρέπει να μην απευθυνόμαστε σε συγκεκριμένο άτομο καθότι είναι έτσι ένας τρόπος που αποκλείουμε τους υπόλοιπους χρήστες του Forum να απαντήσουν και αυτοί.

Για οτιδήποτε κρίνεις πως χρίζει προσωπικού επιπέδου ερωτήσεις μπορείς να χρησιμοποιήσεις το PM (Προσωπικό μήνυμα σε συγκεκριμένο χρήστη).

Επίσης για λόγους Spam δεν δημοσιεύουμε ποτέ το email μας. Δηλαδή οι Spammers χρησιμοποιώντας Robot σαρώνουν όλο το Internet και κατά επέκταση και το Forum Και διαβάζουν το email σου.

Τηρώντας λοιπόν τους παραπάνω κανόνες ανέφερέ μας τι ακριβώς προσπαθείς να κάνεις με την εφαρμογή σου ώστε να προτείνουμε με την σειρά μας πιθανές λύσεις.

Καλημέρα
τρέχω των πρακάτω κωδικα με access.adp 2007 και βαση SQL (μετατροπή απο 2003 σε 2007) και στο "SetTbl=CurrentDb.TableDefs(TblName)" και εδω μου βγαζει error 91.. εαν το τρεξω με mdb δουλευει κανονικά.. εχω βρει στο διαδικτιο αυτο "CurrentData.AllTables" με αυτο ανοιγει την βάση και διαβαζει τους πινακες.. αλλα δεν μπορω να το προσαρμοσω στον παρακάτω κωδικα που ειναι σαφέστατα πιο λειτουργικος..
Επισης με το ξεκίνημα του κώδικα μου χτυπάει και εδώ "PrintTemp"

Σας ευχαριστώ

Dim Fld As Object, Tbl As TableDef, RcdSetTable As DAO.Recordset, TempTxt as String
Set Tbl = CurrentDb.TableDefs(TblName)
Set RcdSetTable = Dbs.OpenRecordset("Select * From " & TblName & " Where AccEidosCode=" & CustID)
If Not RcdSetTable.EOF And Not RcdSetTable.BOF Then
For Each Fld In Tbl.Fields
TempTxt=TempTxt & Fld & vblf
Next
'Καλούμε το PrintTemp
PrintTemp "tmp.txt", TempTxt
End If
End Function

Κώστα καλημέρα σου ζήτησα να μιλήσουμε τηλεφωνικός, και σου ζητώ συγνώμη γι αυτο, αλλα το έκανα επειδη με πιέζει ασφυκτικά ο χρόνος..! είναι μια εφαρμογή που δουλευει σε μια επιχειριση..

Σε καλημερίζω και πάλι

Καλημέρα σε όλους!
Γιώργο, μας είναι δύσκολο να κατανοήσουμε το πρόβλημα σου αφού εκ των πραγμάτων, δεν μπορούμε να γνωρίζουμε το περιβάλλον που εκτελείται το αρχείο σου.

Ειδικά όταν πρόκειται για *. adp σε εταιρία, μας είναι αδύνατον να γνωρίζουμε τις ρυθμίσεις ασφαλείας κλπ. για να μπορέσουμε να σε βοηθήσουμε παραπάνω.

Πχ. ίσως τα δικαιώματα χρήστη να μην επιτρέπουν να εκτελεστεί Shell.

Δες στο συνημμένο πως μπορείς να εκτυπώσεις σε Word ή σε απλό αρχείο κειμένου κάτω από “κανονικές συνθήκες“.

Κάτι άλλο, δεν θα μπορέσει να σου προσφέρει κανείς αν δεν έχει τις απαραίτητες πληροφορίες.

Με εκτίμηση

Τάσος

Καταρχην θέλω αληθινα να σας ευχαριστησω για το πραγματικο σας ενδιαφερων.. Επισης να σας πω οτι θεωρω το ολο ενχηρημα (ms-office) μια πραγματικά πολύ σημαντική πύλη για όσους ασχολούμαστε με το αντικείμενο..!
Είναι πραγματικότητα ότι λόγο της πίεσης χρόνου ίσως δεν είμουν σαφής.. και σας ταλαιπώρησα, παρ΄ολα αυτά ανταποκρι8ήκατε άμεσα..

περιβάλον βάσης SQL 2005 σύνδεση με sa χωρίς κωδικό περιβάλον access 2007 *adp


Λοιπόν το πρώτο ερώτημα (που απάντησε πολύ ευστοχα ο κώστας αλλα αφορούσε mdb και που εκει δουλεύει κανονικότατα) είναι το εξής

Θέλω να ανοίξω έαν πίνκα απο μια βάση (υπάρχουν 28 βάσοις δεδομ).
και να κανω αναζήτηση "οριζόντια", "καθετα" κανω με τον γνωστό σε εμενα τροπο

Dim gggg as adodb.recor...
set gggg = new recor..
klp..

δλδ.

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

μου έστειλε ένα κωδικα ο κώστας αλλα μάλλον αφορά mdb και μου χτυπάει στο

Set Tbl = dbs.TableDefs() με error 91. (εαν ρίξετε μια ματια παραπάνω 8α δείτε τον όλο κώδικα που έστειλε ο κώστας)

προφανός για adp πρέπει να διαμορφο8εί κάπος διαφορετικά..!


Τώρα όσο για την εκτύπωση με κώδικα.. τι ενοώ

Θέλω να ανοίξω ένα πινακα (με τον κοινό τρόπο) και στην συνέχεια τα δεδομένα που υπάρχουν να τα στείλω στον εκτυπωτή

π.χ

ο Πινακας έχει 10 εγγραφές σύμφωνα με το κριτίριο που του έδωσα..

Θέλω λοιπόν να εκτυπώσω 10 γραμμές σε ένα προτυπομένο έντυπο

1 διεύθηνση
2 Στοιχεία πελάτη
3 επάγγελμα
4 Παρατηρήσεις
5 κλπ
6 κλπ
7 κλπ
8 κλπ
9 κλπ
10 κλπ

δεν ξέρω τώρα εά ειμαι σαφής σε αυτο που 8έλω να φτιάχω..

Καλημέρα σε όλους!

Γιώργο,
Για να εκτυπώσεις τις εγγραφές που χρειάζεσαι, θα πρέπει να δημιουργήσεις
ένα ερώτημα και μια έκθεση που τα δεδομένα της θα πηγάζουν απ αυτό.

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

Φρόντισε να διαμορφώσεις τα πεδία, αλλά και ολόκληρη την έκθεση έτσι που να μην εμφανίζονται περιγράμματα κτλ.

Για να κάνεις ενημέρωση σε πίνακα μέσω *.Adp μπορείς να χρησιμοποιήσεις το παρακάτω παράδειγμα:

Option Compare Database

Option Explicit



Private Sub cmdPrintToNotepad_Click()

    Dim rs As New ADODB.Recordset

    With rs

    

        .Open "SELECT * FROM Customers WHERE Customers.ID = " & _

        "το κριτήριο σου (πχ.Me.Combobox...)", _

        CurrentProject.AccessConnection, 1, 3

        

        If Not .EOF And Not .BOF Then

            MsgBox "Id = " & .Fields(0) & _

                   vbLf & "Company = " & .Fields(1)

            .Fields(1).Value = "νέα τιμή"

            ' Ο κώδικας σου εδώ......

            '.......................................

            '.......................................

            '.......................................

            .Update

        Else

            .Close

            Exit Sub

        End If

        .Close

    End With

End Sub

καλημερα Τασο

Δεν ειναι απολυτο ότι πρεπει να διμιουργήσεις ερωτημα SQL για να επιλεξεις εγγραφες.. μεσα απο τον κωδικα οπως γνωριζεις μπορεις να βαλεις τα κριτιρια που θες και να επιλεξεις εγγραφες και δεδομενα..

Το ερώτημα δεν ειναι η επιλογή εγγραφών η δεδομένων.. ουτε η εκτύπωση με εκθεση.. και τα δυο τα γνωριζω αρκετα καλα.. Το ερώτημα είναι πως γίνετε να ανοιξεις εναν πινακα η ενα ερωτημα.. με κωδικα παντα.. και στην συνεχεια να κανεις εκτυπωση μέσα απο τον κωδικα.. χωρις εκθεση.. οπως γινοτανε παλαιοτερα με τα DOS.. αυτο ητανε το ερωτημα..!

και 8ελω να το κανω ετσι γιατι ελεγχο καλητερα τις εκτυπωτικες γραμμες..

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

Διαφορετικά, μέσα στο συνημμένο του μηνύματος http://www.ms-office.gr/forum/808-post11.html
υπάρχει κώδικας για εκτύπωση.

Το πώς θα ανοίξεις έναν πίνακα SQL (SA χωρίς Password) προγραμματιστικά, το βλέπεις καθαρά στο προηγούμενο μήνυμα μου.

Dim printpelates As ADODB.Recordset
Set printpelates = New Recordset

printpelates.Open "SELECT KodikosPelati,Texnikos,Eidos FROM Kataxorisi", CurrentProject.Connection, adOpenKeyset, adLockOptimistic

printpelates.MoveFirst

Dim printName As String

printName = "\\PEER_1\EID"

Open (printName ) For Output As #1

Write #1, "..."
While Not printpelates.EOF
Write #1, "123" & " - " & "sgsgsgsg" & " - " & "printpelates.Fields("KodikosPelati")" & " - " & "printpelates.Fields("Texnikos")"
Write #1, ""
Write #1, "...."
Write #1, "..."
Write #1, "..."
Write #1, ""
printpelates.MoveNext
GoTo TELOS
Wend

TELOS:

Close #1 ' Close file.

Αυτο εδώ έψαχνα.. με κουρασε αλλα το βρήκα..
με τον κωδικα αυτο τυπώνεις μεσα απο ρουτινα..

Σας ευχαριστώ πάντος που ασχοληθήκατε..

φιλικά Γιώργος

Βεβαια με ταλαιπωρουν λίγο τα ελληνικά αλλα θα την βρω την λύση...
Δλδ στον εκτυπωτή τα ελληνικά τα στέλνει τσαχπινογαργαλιρικα... ενω τα αγγλικά κανονικά..

Υ.Γ ο κώδικας που εστειλα παραπάνω θέλει λίγο σημαζεμα..!! αλλα επειδη με κουρασε τον εστειλα ετσι τον ατιμο..!!

Function StrTrans(str As String) As String

Dim i As Integer
Dim outStr As String, S As Byte
For i = 1 To Len(str)
S = Asc(Mid(str, i, 1))
Select Case S
Case 193: outStr = outStr & Chr(128) '"Α"
Case 162: outStr = outStr & Chr(128) '"Ά"
Case 194: outStr = outStr & Chr(129) '"Β"
Case 195: outStr = outStr & Chr(130) '"Γ"
Case 196: outStr = outStr & Chr(131) '"Δ"
Case 197: outStr = outStr & Chr(132) '"Ε"
Case 184: outStr = outStr & Chr(132) '"Έ"
Case 198: outStr = outStr & Chr(133) '"Ζ"
Case 199: outStr = outStr & Chr(134) '"Η"
Case 185: outStr = outStr & Chr(134) '"Ή"
Case 200: outStr = outStr & Chr(135) '"Θ"
Case 201: outStr = outStr & Chr(136) '"Ι"
Case 186: outStr = outStr & Chr(136) '"Ί"
Case 202: outStr = outStr & Chr(137) '"Κ"
Case 203: outStr = outStr & Chr(138) '"Λ"
Case 204: outStr = outStr & Chr(139) '"Μ"
Case 205: outStr = outStr & Chr(140) '"Ν"
Case 206: outStr = outStr & Chr(141) '"Ξ"
Case 207: outStr = outStr & Chr(142) '"Ο"
Case 188: outStr = outStr & Chr(142) '"Ό"
Case 208: outStr = outStr & Chr(143) '"Π"
Case 209: outStr = outStr & Chr(144) '"Ρ"
Case 211: outStr = outStr & Chr(145) '"Σ"
Case 212: outStr = outStr & Chr(146) '"Τ"
Case 213: outStr = outStr & Chr(147) '"Υ"
Case 190: outStr = outStr & Chr(147) '"Ύ"
Case 214: outStr = outStr & Chr(148) '"Φ"
Case 215: outStr = outStr & Chr(149) '"Χ"
Case 216: outStr = outStr & Chr(150) '"Ψ"
Case 217: outStr = outStr & Chr(151) '"Ω"
Case 191: outStr = outStr & Chr(151) '"Ώ"
Case 225: outStr = outStr & Chr(152) '"α"
Case 226: outStr = outStr & Chr(153) '"β"
Case 227: outStr = outStr & Chr(154) '"γ"
Case 228: outStr = outStr & Chr(155) '"δ"
Case 229: outStr = outStr & Chr(156) '"ε"
Case 230: outStr = outStr & Chr(157) '"ζ"
Case 231: outStr = outStr & Chr(158) '"η"
Case 232: outStr = outStr & Chr(159) '"θ"
Case 233: outStr = outStr & Chr(160) '"ι"
Case 234: outStr = outStr & Chr(161) '"κ"
Case 235: outStr = outStr & Chr(162) '"λ"
Case 236: outStr = outStr & Chr(163) '"μ"
Case 237: outStr = outStr & Chr(164) '"ν"
Case 238: outStr = outStr & Chr(165) '"ξ"
Case 239: outStr = outStr & Chr(166) '"ο"
Case 240: outStr = outStr & Chr(167) '"π"
Case 241: outStr = outStr & Chr(168) '"ρ"
Case 243: outStr = outStr & Chr(169) '"σ"
Case 242: outStr = outStr & Chr(170) '"ς"
Case 244: outStr = outStr & Chr(171) '"τ"
Case 245: outStr = outStr & Chr(172) '"υ"
Case 246: outStr = outStr & Chr(173) '"φ"
Case 247: outStr = outStr & Chr(174) '"χ"
Case 248: outStr = outStr & Chr(175) '"ψ"
Case 249: outStr = outStr & Chr(224) '"ω"
Case 220: outStr = outStr & Chr(225) '"ά"
Case 221: outStr = outStr & Chr(226) '"έ"
Case 222: outStr = outStr & Chr(227) '"ή"
Case 250: outStr = outStr & Chr(228) '"ϊ"
Case 223: outStr = outStr & Chr(229) '"ί"
Case 252: outStr = outStr & Chr(230) '"ό"
Case 253: outStr = outStr & Chr(231) '"ύ"
Case 251: outStr = outStr & Chr(232) '"ϋ"
Case 254: outStr = outStr & Chr(233) '"ώ"
Case 128: outStr = outStr & Chr(238) '"€"
Case 218: outStr = outStr & Chr(136) '"Ϊ"
Case 219: outStr = outStr & Chr(147) '"Ϋ"
Case Else: outStr = outStr & Chr(S)
End Select
Next i
StrTrans = outStr
End Function


Αυτος ο κωδικας μετατρεπει τα τσαχπινογαργαλιρικα ελληνικα σε ελληνικα οταν τα στελνει στον εκτυπωτη..

Καληνυχτα σε ολους

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

Καλό ξημέρωμα!

Καλημέρα,

Επιστρέφοντας στο Θέμα, θα συμφωνήσω με τον Τάσο πως εν τέλη θα πρέπει να μας δίδεται μια ολοκληρωμένη παρουσίαση του προβλήματος.

Επισημαίνω πως πάντα θα χρειαζόμαστε μια το κατά δύναμην λεπτομερή παρουσίαση προβλήματος με αναφορά στο τι σκοπεύουμε να επιτύχουμε.

Η αναφορά στο τι σκοπεύουμε να επιτύχουμε θα βοηθήσει τους χρήστες του Forum να δώσουν εναλλακτικές λύσεις που αρκετές φορές μπορεί να είναι ευκολότερες από τον προτεινόμενο τρόπο λύσης που αναζητά ο χρήστης που έθεσε το ερώτημα.

καλημερα σε όλους .. θέλω να ξεκαθαρισω οτι δεν αφηνω αιχμες για κανεναν..

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

θεωρώ πως η ανταλλαγή απόψεων και η βοηθεια είναι πολύ σημαντική..! και αυτος εδώ ο χώρος το κάνει..!!!!

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

Σημασία έχει ότι μπορούμε και αληλοβοηθιόμαστε..

Να έχετε μια όμορφη ημέρα

Φιλικά Γιώργος