Option Explicit
Sub Macro1()
'
'
Dim Chemin As String, DDV As String, PLANNING As String
Dim Nom As String, Autorise As String
Dim Pointeur As Long, Longueur As Long
Chemin = ThisWorkbook.Path & "\"
DDV = "DDV.xls"
PLANNING = "PLANNING.xls"
Autorise = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefjhijklmnopqrstuvwxyz_0123456789"
Workbooks.Open Chemin & DDV
With Workbooks(PLANNING).Sheets("2012")
Workbooks(DDV).Sheets("Fiche vente").Range("B1").Value = .Range("B2")
Workbooks(DDV).Sheets("Fiche vente").Range("D1").Value = .Range("C2")
Workbooks(DDV).Sheets("Fiche vente").Range("A4").Value = .Range("D2")
Workbooks(DDV).Sheets("Fiche vente").Range("C5").Value = .Range("E2")
Workbooks(DDV).Sheets("Fiche vente").Range("E5").Value = .Range("F2")
End With
Nom = Workbooks(DDV).Sheets("Fiche vente").Range("B1") & ".xls"
'si le document n'a jamais été enregistré
If Workbooks(DDV).Path = "" Then
'boîte de dialogue Enregistrer sous
Application.GetSaveAsFilename Chemin & Nom, FileFilter:="Fichier Excel (*.xls), *.xls", Title:="Choisir un dossier"
Else
If Nom = "" Then
Reprise:
Nom = InputBox("Entrez le nom du fichier ")
Workbooks(DDV).Sheets("Fiche vente").Range ("B1") & ".xls" = Nom
End If
If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
If Dir(Chemin & Nom) <> "" And Nom <> "DDV.xls" Then Kill Chemin & Nom
'Enregistre dans le même dossier
Pointeur = 0
Longueur = Len(Nom)
Do
Pointeur = Pointeur + 1
If InStr(1, Autorise, Mid(Nom, Pointeur, 1)) = 0 Then
MsgBox "Le nom proposé contient un caractère interdit : " & Mid(Nom, Pointeur, 1), 48
GoTo Reprise
End If
Loop Until Pointeur = Longueur
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & Nom
End If
End If