Discussion :

[djflnj]

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

[patricktoulon]

bonjour et bien venu sur le forum



tout d'abords il faudrai savoir si l'image que tu veux exporter tu l'a inséré ou si c'est une image des cellules

dans le cas numéro 2 il faudrai t que tu rajoute en début de 2eme macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
sheets("blablabla").range("a1:g30).copypicture 'et après l'insérer dans le chart vide

au plaisir

[djflnj]

bonsoir,

merci pour ta réponse .

oui c'est pour inserer une image de célulle.

mais à quel endroit doit-je inserer cette ligne

peut tu, me remetre le code macro complet stp

merci

[mercatog]

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
Sub NumeriseFactureJpg()
Dim Plage As Range
 
Application.ScreenUpdating = False
With Sheets("Facture")
    Set Plage = .Range("A1:M40")
    Plage.CopyPicture
    With .ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height).Chart
        .Paste
        .Export ThisWorkbook.Path & "\Essai.jpg", "JPG"
    End With
    .ChartObjects(.ChartObjects.Count).Delete
End With
MsgBox "Numérisation facture terminée"
Set Plage = Nothing
End Sub

[djflnj]

Bonjour,

l'image ce créer bien merci pour cette aide mais je voudrais quelle s'enregistre dans le dossier Client et non dans le dossier dans lequel j'execute le fichier xlsm

cordialement

[mercatog]

adaptes cette ligne donc à tes besoins

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        .Export ThisWorkbook.Path & "\Essai.jpg", "JPG"

en remplaçant le chemin et le nom de l'image