Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια! |
| Εργαλεία Θεμάτων | Τρόποι εμφάνισης |
#1
| |||
| |||
Συνάρτηση μέσα σε Module,Απορία
Kαλησπερα.Μια απορια αν μπορει να λυθει βεβαια εχω αυτον τον κωδικα μεσα σε μια αναφορα Option Compare Database Option Explicit Const strParentFolder As String = "C:\test" Private Function MakeNameFolder() As String Dim strname As String If dir(strParentFolder, vbDirectory) = "" Then MkDir strParentFolder End If If Len(Me.ΟΝΟΜΑ) * Len(Me.ΕΠΙΘΕΤΟ) Then strname = Replace(Me.ΟΝΟΜΑ, " ", "_") & "_" & _ Replace(Me.ΕΠΙΘΕΤΟ, " ", "_") End If MakeNameFolder = strParentFolder & strname End Function Γινεται με καποιο τροπο να μπει σε module γιατι οπως θα δειτε στον παρακατω κωδικα που ειναι σε module η function MakeNameFolder() καλειται απο την function pdfSave() .Αν βαλω την function MakeNameFolder() στο module εχω error λογω του If Len(Me.ΟΝΟΜΑ) * Len(Me.ΕΠΙΘΕΤΟ) Then strname = Replace(Me.ΟΝΟΜΑ, " ", "_") & "_" & _ Replace(Me.ΕΠΙΘΕΤΟ, " ", "_") Ο κωδικας στο module Function CreateReportShortcutMenu() Dim MenuName As String Dim CB As CommandBar Dim CBB As CommandBarButton MenuName = "vbaShortCutMenu" On Error Resume Next Application.CommandBars(MenuName).Delete On Error GoTo 0 Set CB = Application.CommandBars.Add(MenuName, msoBarPopup, False, False) '''''''''''''''''''''''''''''''''''''' Set CBB = CB.Controls.Add(msoControlButton, 25, , , True) CBB.Caption = "Zoom" Set CBB = CB.Controls.Add(msoControlButton, 5, , , True) CBB.Caption = "Μία σελίδα" '''''''''''''''''''''''''''''''''''''' Set CBB = CB.Controls.Add(msoControlButton, 247, , , True) CBB.BeginGroup = True CBB.Caption = "Διαμόρφωση σελίδας" Set CBB = CB.Controls.Add(msoControlButton, 15948, , , True) CBB.Caption = "Εκτύπωση" '''''''''''''''''''''''''''''''''''''' Set CBB = CB.Controls.Add(msoControlButton, 11723, , , True) CBB.BeginGroup = True CBB.Caption = "Εξαγωγή σε Excel" Set CBB = CB.Controls.Add(msoControlButton, 12951, , , True) CBB.Caption = "Εξαγωγή σε Pdf / Xps" 'CBB.FaceId = 3 CBB.OnAction = "=pdfSave()" 'create a public function for the Action Set CBB = CB.Controls.Add(msoControlButton, 2188, , , True) CBB.Caption = "Αποστολή με E-mail" '''''''''''''''''''''''''''''''''''''''''''''''''' ''' Set CBB = CB.Controls.Add(msoControlButton, 14782, , , True) CBB.BeginGroup = True CBB.Caption = "Κλείσιμο" Set CB = Nothing Set CBB = Nothing End Function Function name() MakeNameFolder End Function Function FileExist(FileFullPath As String) As Boolean Dim value As Boolean value = False If dir(FileFullPath) <> "" Then value = True End If FileExist = value End Function Public Function pdfSave() As String Dim strNewFolder As String Dim fileName As String, fldrPath As String, filePath As String Dim answer As Integer Dim strFolder As String On Error GoTo err_Hander strFolder = MakeNameFolder() strNewFolder = MakeNameFolder() fileName = "Αίθουσα_Τοκετών" & "_" & Format(date, "dd-mm-yyyy") filePath = strNewFolder & "\" & fileName & ".pdf" If strNewFolder <> "" Then If dir(strNewFolder, vbDirectory) = "" Then MkDir strNewFolder MsgBox "Δημιουργήθηκε φάκελος" & vbCrLf & strNewFolder, vbOKOnly + vbInformation, "Φάκελος Ειδικευόμενου" End If If FileExist(filePath) Then answer = MsgBox("Tο αρχείο υπάρχει ήδη" & vbNewLine & filePath & vbNewLine & vbNewLine & _ "Να γίνει αντικατάσταση;", vbYesNo + vbInformation, "Αντικατάσταση") If answer = vbNo Then Exit Function Else DoCmd.OutputTo acReport, "Αίθουσα_Τοκετών", acFormatPDF, filePath MsgBox "Το αρχείο αντικαταστάθηκε στον φάκελο " & vbCrLf & filePath, vbOKOnly + vbInformation, "Αποθήκευση αναφοράς" Shell "EXPLORER.EXE" & " " & Chr(34) & strFolder & Chr(34), vbNormalFocus End If Else DoCmd.OutputTo acReport, "Αίθουσα_Τοκετών", acFormatPDF, filePath MsgBox "Το αρχείο αποθηκεύτηκε στον φάκελο " & vbCrLf & filePath, vbOKOnly + vbInformation, "Αποθήκευση αναφοράς" Shell "EXPLORER.EXE" & " " & Chr(34) & strFolder & Chr(34), vbNormalFocus End If End If Exit Function err_Hander: MsgBox "Error #" & Err.Number & vbCrLf & Err.Description End Function Τελευταία επεξεργασία από το χρήστη Tasos : 10-07-20 στις 17:22. |
#2
| |||
| |||
Καλησπέρα Γιάννη, Τον παρακάτω κώδικα (Function) μπορείς να τον βάλεις στο ίδιο Module: Public Function MakeNameFolder(ByVal sEpitheto As String, ByVal sOnoma As String) As String Const strParentFolder As String = "C:\test" Dim strname As String If Dir(strParentFolder, vbDirectory) = "" Then MkDir strParentFolder End If If Len(sOnoma) * Len(sEpitheto) Then strname = Replace(sOnoma, " ", "_") & "_" & _ Replace(sEpitheto, " ", "_") End If MakeNameFolder = strParentFolder & strname End Function Αντικατέστησε των κώδικα που έχεις στην αναφορά με: str=MakeNameFolder(Me.ΕΠΙΘΕΤΟ, Me.ΟΝΟΜΑ) Ευχαριστώ. |
#3
| |||
| |||
Γιωργο θα το δοκιμασω και θα σε ενηνερωσω.Επθσης γιβεται κατα την εξαγωγη σε pdf να παιρνει δυναμικα το τιτλο της αναφορας; fileName = "Αίθουσα_Τοκετών" & "_" & Format(date, "dd-mm-yyyy") |
« Προηγούμενο Θέμα
|
Επόμενο Θέμα »
| |
Παρόμοια Θέματα | ||||
Θέμα | Δημιουργός | Forum | Απαντήσεις | Τελευταίο Μήνυμα |
[VBA] Χρησιμοποίηση μεταβλητής σε διαφορετικό module | Βασίλης Καραχάλιος | Excel - Ερωτήσεις / Απαντήσεις | 3 | 01-07-20 23:34 |
[Συναρτήσεις] Συνάρτηση μέσα στο αποτέλεσμα της IF | alex7 | Excel - Ερωτήσεις / Απαντήσεις | 7 | 28-01-16 11:47 |
Kώδικας σε module | alex | Access - Ερωτήσεις / Απαντήσεις | 0 | 22-10-12 14:50 |
[Συναρτήσεις] Απορία για συνάρτηση | KostasKJ7 | Excel - Ερωτήσεις / Απαντήσεις | 5 | 21-02-12 15:47 |
Διόρθωση κώδικα σε Module | alex | Access - Ερωτήσεις / Απαντήσεις | 2 | 12-08-11 14:01 |
Η ώρα είναι 14:50.