Συνάρτηση μέσα σε 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

Καλησπέρα Γιάννη,

Τον παρακάτω κώδικα (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.ΟΝΟΜΑ)

Ευχαριστώ.

Γιωργο θα το δοκιμασω και θα σε ενηνερωσω.Επθσης γιβεται κατα την εξαγωγη σε pdf να παιρνει δυναμικα το τιτλο της αναφορας;

fileName = "Αίθουσα_Τοκετών" & "_" & Format(date, "dd-mm-yyyy")