Sub copiePDF() 'code copie en PDF et classement
Dim sNomDossier As String
Dim sNomFichierPDF As String
sNomDossier = ThisWorkbook.Path
sNomFichierPDF = Format(Feuil1.Range("l5"), "dddd dd mmmm yyyy") & " n° " & Range("z58") 'nom du fichier + N° de document
sNomDossier = ThisWorkbook.Path & "\année 2013\" & Format(Feuil1.Range("l5 "), "mmmm yyyy") & "\"
If Len(sNomFichierPDF) > 0 Then
If NomFichierValide(sNomFichierPDF) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sNomDossier & "/" & _
sNomFichierPDF & ".pdf" _
, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
Feuil1.Range("l5").Select
MsgBox "Ce nom de fichier est invalide", vbOKOnly + vbInformation, "Nom de Fichier"
End If
End If
' MsgBox ("Le fichier PDF nommé " & sNomFichierPDF & " à bien été crée dans le répertoire " & sNomDossier)
End Sub
'suite code copie PDF
Private Function NomFichierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
NomFichierValide = True
For i = 1 To Len(CaracInterdits)
If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
NomFichierValide = False
Exit Function
End If
Next i
End Function