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
| Sub Macro2_save()
'PARTIE 1
Dim Chemin1$, Chemin2$, Chemin3$, Chemin4$, Types$, Client$, Fichier$, Numfact$, Jour$, Facturation$, Client1$, Image$
' Création et Enregistrement du client sur la clé USB
Chemin1 = "i:\MENU_Factures\"
' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur l'ordi bureau
Chemin2 = "F:\Users\Christ\Desktop\MENU_Factures\"
' Création et Enregistrement du client sur ordi maison.
Chemin3 = "F:\Users\Christ\Desktop\MENU_Factures\"
'Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur la clé USB
Chemin4 = "i:\MENU_Factures\"
Jour = Format(Day(Now()), "00") & Format(Month(Now()), "00") & Year(Now)
Client = Range("c4")
Client1 = Range("a1")
Numfact = Range("c3")
Types = Range("b3")
Facturation = Range("a1")
Fichier = Jour & "_" & Types & "_" & Numfact & ".xls"
Image = Jour & "_" & Types & "_" & Numfact & ".jpg"
' Création et Enregistrement du client sur la clé USB
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur l'ordi bureau
Facturation = Facturation & ".xlsm"
If Dir(Chemin2 & Client1, 16) = "" Then MkDir Chemin2 & Client1
ActiveWorkbook.SaveAs Chemin2 & Client1 & "\" & Client1
' Enregistrement sur ordi maison dossier client
If Dir(Chemin3 & Client, 16) = "" Then MkDir Chemin3 & Client
ActiveWorkbook.SaveAs Chemin3 & Client & "\" & Fichier
' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur la clé USB
Facturation = Facturation & ".xlsm"
If Dir(Chemin4 & Client1, 16) = "" Then MkDir Chemin4 & Client1
ActiveWorkbook.SaveAs Chemin4 & Client1 & "\" & Client1
'PARTIE 2
Dim Plage As Range
Application.ScreenUpdating = False
With Sheets("Facture")
Set Plage = .Range("b1:g51")
Plage.CopyPicture
With .ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height).Chart
.Paste
.Export ThisWorkbook.Path & Client & Image
End With
.ChartObjects(.ChartObjects.Count).Delete
End With
MsgBox "Numérisation de la facture terminée"
Set Plage = Nothing
End Sub |
Partager