Bonsoir à toutes et tous,

Je voudrais savoir si quelqu'un peut m'aider sur mon code si suivant.
explication:

J'ai une macro " Sub Macro4_save_maison() " qui fonctionne très bien mais je voudrais lui rajouter une fonction supplémentaire, que j'ai trouvé sur le forum, une macro qui permet de faire une image jpg ou gif ( de préférence je hopte pour le JPG ) et je voudrais rajouter cette macro à ma macro.

Quand je clique sur mon Bouton "Enregistrement" à lequel j'ai affecté ma macro je voudrais qu'il créer un fichier image.jpg qui porterait le même nom que ma facture ex : "17092010_FACTURE N°_2010-xx.xls"

Que l'enregistrement fichier image.jpg ce face dans le même dossier qui vient d'être crèèr par la partie1 de ma macro.

Mais quand la macro arrive à la partie 2, celle que j'ai rajouté à ma macro rien ne ce passe je vous joint ci-dessous ma macro complète.

Avec tout mes remerciement par avance
'PARTIE 1
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub Macro4_save_maison()
Dim Chemin1$, Chemin2$, Chemin3$, Chemin4$, Types$, Client$, Fichier$, Numfact$, Jour$, Facturation$, Client1$
Chemin1 = "i:\Factures\"
Chemin2 = "d:\Users\admin\Desktop\MENU_Factures\"
Chemin3 = "d:\Users\admin\Desktop\MENU_Factures\"
Chemin4 = "i:\Factures\1 - 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"
 
' Enregistrement sur clé USB dossier client
 
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
 
' Sauvegarde sur ordi maison Fichier xlsm
 
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
 
' Sauvegarde sur clé USB Fichier xlsm
 
Facturation = Facturation & ".xlsm"
If Dir(Chemin4 & Client1, 16) = "" Then MkDir Chemin4 & Client1
ActiveWorkbook.SaveAs Chemin4 & Client1 & "\" & Client1
 
'End Sub
'PARTIE 2

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
'Sub ExtractionImagesFeuille()
'auteur:SilkyRoad
 
Dim Pict As Picture
Dim Nb As Byte
 
Application.ScreenUpdating = False
 
For Each Pict In Worksheets("Facture").Pictures
Pict.CopyPicture 'copie l'image
 
With Worksheets("Facture").ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
.Paste 'colle l'image dans un graphique temporaire
'Sauvegarde au format image, dans le même répertoire que ce classeur.
.Export ThisWorkbook.Path & "\" & Pict.Name & ".gif", "GIF"
End With
 
'Supprime le graphique
Nb = Worksheets("Facture").ChartObjects.Count
Worksheets("Facture").ChartObjects(Nb).Delete
Next Pict
 
Application.ScreenUpdating = True
End Sub