1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
|
Option Explicit
Dim chemin As String
Dim PathSep As String
Dim nom As String
Sub Archivage_Devis()
chemin = ThisWorkbook.Path
PathSep = Application.PathSeparator
nom = [D8].Value & "-" & Year([E3]) & "-" & MonthName(Format([E3], "mm")) & "-" & Format([K5], "0000") & ".xlsm"
'---------------------Création du fichier temporaire
If [K5] = "" Then MsgBox "Veuillez saisir en cellule K5 le numéro du devis", , "Création abandonnée !": Exit Sub
If MsgBox(" Si le devis est entièrement édité, veuillez confirmer" & vbCrLf & vbCrLf & _
" l'archivage du devis n° " & nom, vbYesNo, " Veuillez confirmer pour poursuivre,") = vbYes Then
Application.EnableEvents = False
Application.DisplayAlerts = False '-------Annulation des alertes
'---------------------Nom du fichier à créer extension xls
ActiveSheet.Shapes.Range(Array("Bouton1")).Visible = False
' ActiveSheet.PrintOut copies:=1
Sheets("Devis").Copy
ActiveWorkbook.SaveAs chemin & PathSep & "Archives Devis" & PathSep & nom, FileFormat:=52
ActiveWindow.Close
'---------------------Après l'archivage le fichier se réinitialise
ActiveSheet.Shapes.Range(Array("Bouton1")).Visible = True
Sheets("Devis").Range("E3,E4,A13:G17,A19:F22,G27").ClearContents
Sheets("Devis").Range("K5").Value = Sheets("Devis").Range("K5").Value + 1
Application.DisplayAlerts = True '-------rétablissement des alertes
Application.EnableEvents = True
End If
[K5].Select
ActiveWorkbook.Save
End Sub
Sub Archivage_Factures()
chemin = ThisWorkbook.Path
PathSep = Application.PathSeparator
nom = [D8].Value & "-" & Year([E3]) & "-" & MonthName(Format([E3], "mm")) & "-" & Format([K5], "0000") & ".xlsm"
'---------------------Création du fichier temporaire
If [K5] = "" Then MsgBox "Veuillez saisir en cellule K5 le numéro de la facture", , "Création abandonnée !": Exit Sub
If MsgBox(" Si la facture est entièrement éditée, veuillez confirmer" & vbCrLf & vbCrLf & _
" l'archivage de la facture n° " & nom, vbYesNo, " Veuillez confirmer pour poursuivre,") = vbYes Then
Application.EnableEvents = False
Application.DisplayAlerts = False '-------Annulation des alertes
'---------------------Nom du fichier à créer extension xls
Sheets("Facture").Shapes.Range(Array("Bouton2")).Visible = False
' ActiveSheet.PrintOut copies:=1
Sheets("Facture").Copy
ActiveWorkbook.SaveAs chemin & PathSep & "Archives Factures" & PathSep & nom, FileFormat:=52
ActiveWindow.Close
'---------------------Après l'archivage le fichier se réinitialise
Sheets("Facture").Shapes.Range(Array("Bouton2")).Visible = True
Sheets("Facture").Range("E3,E4,A14:G21,F24:G24").ClearContents
Sheets("Facture").Range("K5").Value = Sheets("Facture").Range("K5").Value + 1
Application.DisplayAlerts = True '-------rétablissement des alertes
Application.EnableEvents = True
End If
[K5].Select
ActiveWorkbook.Save
End Sub |
Partager