Option Explicit
Private Function CreationDossier(ByVal sChemin As String) As Boolean
Dim i As Integer, sTmp As String, Ar() As String
If InStr(sChemin, ":") = 0 Then
Ar = Split(CurDir & "\" & sChemin, "\")
Else
Ar = Split(sChemin, "\")
End If
sTmp = Ar(0)
ChDrive sTmp
For i = LBound(Ar) + 1 To UBound(Ar)
If Ar(i) <> "" Then
sTmp = sTmp & "\" & Ar(i)
On Error Resume Next
MkDir sTmp
On Error GoTo 0
End If
Next i
If Dir$(sChemin, vbDirectory) = vbNullString Then
CreationDossier = False
Else
CreationDossier = True
End If
End Function
Private Function NomValide(ByVal sChaine As Variant) As Boolean
Dim i As Long
Const sCaracInterdits As String = """*/:<>?\|"
NomValide = True
If Len(sChaine) = 0 Then
NomValide = False
Exit Function
End If
For i = 1 To Len(sCaracInterdits)
If InStr(sChaine, Mid$(sCaracInterdits, i, 1)) > 0 Then
NomValide = False
Exit Function
End If
Next i
End Function
Sub Test_03()
Dim SousDossier As String
Dim NomDossier As Variant
Dim Dossier As String
SousDossier = "Ecart de tri"
NomDossier = Application.InputBox("Dossier d'enregistrement", "Enregistrement en PDF", "Bon de livraison")
If NomDossier = False Then Exit Sub
Dossier = ThisWorkbook.Path & "\" & NomDossier & "\" & SousDossier & "\"
If NomValide(Range("F2")) = False Then
MsgBox "Nom de Fichier invalide", vbCritical + vbOKOnly
Range("F2").Select
Exit Sub
End If
If NomValide(Range("F3")) = False Then
MsgBox "Nom de Fichier invalide", vbCritical + vbOKOnly
Range("F3").Select
Exit Sub
End If
If CreationDossier(Dossier) = True Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=Dossier & Range("F2") & "_" & "BL N°" & " " & Range("F3"), _
quality:=xlQualityStandard, _
ignoreprintareas:=False, _
includedocproperties:=True, _
from:=1, To:=1, _
openafterpublish:=False
End If
End Sub