Sub Indicer()
Dim nDevis As String
Dim FirstWord As String, LastWord As String, MidWord As String
Dim Sauvegarde As Variant, Question As Integer
If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then
nDevis = InputBox("Saisir le n° devis (n° actuel : " & Left(ThisWorkbook.Name, 11) & ")" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00"))
Else:
nDevis = InputBox("Saisir le n° devis (D" & Right(Year(Now), 2) & "-XXXX-XX)" & vbCrLf & "Le fichier actuel ne sera pas enregistré." & vbCrLf & "Pensez à enregistrer avant de valider", , ThisWorkbook.Name)
End If
If nDevis = "" Then 'si on clique sur annulé
GoTo msg2
End If
FirstWord = Mid(nDevis, 1, 4) ' Returns "DXX-"
MidWord = Mid(nDevis, 5, 4) ' Returns "XXXX"
LastWord = Mid(nDevis, 9) ' Returns "-XX"
If FirstWord Like "D[0-9][0-9]-" And MidWord Like "[0-9][0-9][0-9][0-9]" And LastWord Like "-[0-9][0-9]" Then
ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & nDevis
MsgBox "Devis indicé"
Else
msg2:
Msg = "Votre n° doit être de la forme : D" & Right(Year(Now), 2) & "-XXXX-XX" & vbCrLf & vbCrLf & "Réessayer Enregistrer sous" & vbCrLf & " | |" & vbCrLf & " \/ \/"
Style = vbYesNoCancel + vbExclamation + vbDefaultButton1
Title = "Erreur dans le numéro de devis"
Help = "DEMO.HLP"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then
Indicer
ElseIf Response = vbNo Then ' Demande ou sauver le doc et le nom à lui donner
If nDevis = "" Then
If ThisWorkbook.Name Like "D##-####-##" & ".xlsm" Then
nDevis = Left(ThisWorkbook.Name, 9) & Format(Mid(ThisWorkbook.Name, 10, 2) + 1, "00")
Else: nDevis = ThisWorkbook.Name
End If
End If
Sauvegarde = Application.GetSaveAsFilename(ActiveWorkbook.Path & "\" & nDevis & ".xlsm", FileFilter:="XLSM (*.xlsm), *.xlsm", Title:="Enregistrer-sous ...")
If Sauvegarde = False Then GoTo msg2 ' Si click sur annuler, alors on revient a la boite de dialoque
If Dir(Sauvegarde) <> "" Then ' le fichier renseigné par l'utilisateur existe-t-il ?
Question = MsgBox("Attention le fichier existe déjà" & Chr(13) & "Voulez vous le remplacer ?", vbQuestion + vbYesNo, "Attention...")
' Si oui, faut t-il l'effacer ?
If Question = 6 Then ' Oui
Kill Sauvegarde ' Efface
Else ' Non
GoTo msg2 ' On revient a la boite de dialoque
End If
End If
ThisWorkbook.SaveAs Sauvegarde ' Sauvegarde
Else: MsgBox "Indiçage annulé" 'si on clique sur annulé
End If
End If
End Sub