Option Explicit
Sub NomFichier()
On Error GoTo Erreur
'Permet de vérifier la cohérence entre le numéro de commande et le modèle de commande utilisé.
Dim Cdeanswer As String
Select Case Mid(Range('NumCommande').Value, 3, 1)
Case 'U' 'Si la lettre du numéro de commande est U, alors...
Cdeanswer = MsgBox('Le numéro de commande tapé ne correspondant au modèle de commande utilisé.', vbCritical, 'ITA')
Case 'T' 'Si la lettre du numéro de commande est T, alors...
Cdeanswer = MsgBox('Le numéro de commande tapé ne correspondant au modèle de commande utilisé.', vbCritical, 'ITA')
Case 'A' 'Si la lettre du numéro de commande est A, alors...
Cdeanswer = MsgBox('Le numéro de commande tapé ne correspondant au modèle de commande utilisé.', vbCritical, 'ITA')
Case 'I' 'Si la lettre du numéro de commande est I, alors...
GoTo 2
End Select
If Cdeanswer = 1 Then
GoTo 1
Else: Resume Next
End If
'Défini le nom à donner au fichier
2 Dim MyName As String
MyName = Application.InputBox('Saisissez vos initiales', 'Initiales') 'ouvre une input box pour la saisie des initials
Select Case MyName
Case False 'Si la valeur retournée est faux (si l'utilisateur clique sur annuler)
GoTo 3
Case '' 'Si l'utilisateur clique sur OK sans saisir ses initiales
GoTo 2
Case Else 'Tous les autres cas
GoTo 4
End Select
4 Dim x As String
x = Range('F15') & '_' & Range('F2') & '_' & MyName 'Crée et stocke sous le nom x la chaîne caractère qui servira de nom à la commande
'Enregistre le fichier Excel avec son nom définitif
ActiveWorkbook.SaveAs Filename:='X:\\' & x, FileFormat:=xlNormal, _
Password:='', WriteResPassword:='', ReadOnlyRecommended:=False, CreateBackup:=False
'Génére un pdf et le place dans le dossier défini
Const ThePath As String = 'X:\\'
Dim Nom As String
Nom = x
Application.SendKeys Keys:=ThePath & Nom + '~'
Sheets('Feuil1').PrintOut ActivePrinter:='Acrobat PDFWriter sur LPT1:'
'Ouvre la boite de dialoque de choix d'imprimante et imprime sur l'imprimante séléctionnée
Application.ActivePrinter = '\\\\w2k-framatome\\Canon iR5000-6000 PCL5e sur Ne02:'
Dim dlganswer As Boolean
dlganswer = Application.Dialogs(xlDialogPrinterSetup).Show
If dlganswer = True Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, collate:=True
End If
GoTo 3
'Empêche l'affichage des messages d'erreur
Erreur:
1
'Ramène le curseur sur la cellule NumCommande
Range('NumCommande').Select
3
End Sub