Création d'une image jpg via une Macro.

Version imprimable

:) Bonsoir à toutes et tous, :lol:

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 :ccool:
Code:

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 :cry:
Code:

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

18/09/2010, 21h42
patricktoulon

heu!...
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:

1 2 sheets("blablabla").range("a1:g30).copypicture 'et après l'insérer dans le chart vide
au plaisir
19/09/2010, 21h33
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

Code:

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

20/09/2010, 09h20
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
20/09/2010, 11h34
mercatog

adaptes cette ligne donc à tes besoins

Code:

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

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

re-bonjour

Désolé, mais depuis se matin j'essai d'adapter cette ligne mais celle ou elle ne fonctionne pas ou le fichier ne s'enregistre pas là ou je le voudrais.
merci de pouvoir de nouveau m'aider.

Se que je souhaiterais c'est que mon fichier .jpg porte le même nom que mon fichier .xls et que celui-ci s'enregistre dans le même dossier que le fichier .xls
le fichier qui se crée dans le dossier Parent et sous cette forme
''1 - Menu de Facturation Radio PlurielFRAM20092010_DEVIS N°_2010-46.jpg''
et je souhaiterais qu'il soit sous cette forme là :
'' FRAM20092010_DEVIS N°_2010-46.jpg''

j'ai essayé plein de modification dans cette ligne ''.Export ThisWorkbook.Path ''
tel qu'en rajoutant le chemin ou je voulais qu'il s'enregistre enlever le ''.Path'' et le remplacer par '' Save, SaveAs, Saved, ... '' mais je tombe sur une erreur.

je ne sais plus quoi essayer, j'espère que tes lumière pourront m'aider.

Voici toute la macro :

Code:

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

Je ne comprends pas la question des Chemin1 à chemin4 (qui sont en double)
sinon, pour enregistrer dans chemin2 par exemple, (j'ai revu le code au passage)

Code:

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
Sub Macro2_save()
Dim Plage As Range
Dim Types$, Client$, Fichier$, Numfact$, Jour$, Facturation$, Client1$, Image$
Const Chemin1 = "i:\MENU_Factures\"
Const Chemin2 = "F:\Users\Christ\Desktop\MENU_Factures\"
Const Chemin3 = "F:\Users\Christ\Desktop\MENU_Factures\"
Const Chemin4 = "i:\MENU_Factures\"
 
Application.ScreenUpdating = False
With Sheets("Facture")
    Jour = Format(Now, "ddmmyyyy")
    Client = .Range("C4")
    Client1 = .Range("A1")
    Numfact = .Range("C3")
    Types = .Range("B3")
    Facturation = .Range("A1")
    Facturation = Facturation & ".xlsm"
 
    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
    ThisWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
 
    ' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur l'ordi bureau
    If Dir(Chemin2 & Client1, 16) = "" Then MkDir Chemin2 & Client1
    ThisWorkbook.SaveAs Chemin2 & Client1 & "\" & Client1
 
    ' Enregistrement sur ordi maison dossier client
    If Dir(Chemin3 & Client, 16) = "" Then MkDir Chemin3 & Client
    ThisWorkbook.SaveAs Chemin3 & Client & "\" & Fichier
 
    ' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur la clé USB
    If Dir(Chemin4 & Client1, 16) = "" Then MkDir Chemin4 & Client1
    ThisWorkbook.SaveAs Chemin4 & Client1 & "\" & Client1
 
    Set Plage = .Range("B1:G51")
    Plage.CopyPicture
    With .ChartObjects.Add(0, 0, Plage.Width + 5, Plage.Height + 5).Chart
        .Paste
        .Export Chemin2 & Client & "\" & Image
    End With
    .ChartObjects(.ChartObjects.Count).Delete
End With
MsgBox "Numérisation de la facture terminée"
Set Plage = Nothing
End Sub

20/09/2010, 15h21
patricktoulon

heu

bonjour

a première vu j'ai survoler ton code

déjà ci tu pouvais le rééditer entre les balises ça serai plus facile pour les lecteurs

et donc a la fin en partie 2 tu sauvegarde l'image venant du sheets facture

peut être faudrais til le réactiver ce classeur étant donner que tu le sauve plusieurs fois avec un nom diffèrent donc quand tu arrive a la partie 2 tu n'est plus sur le classeur de base forcement ta macro va buger

lenomduclasseur.activate juste avant la partie2

au plaisir

Citation:

Envoyé par mercatog

Je ne comprends pas la question des Chemin1 à chemin4 (qui sont en double)
sinon, pour enregistrer dans chemin2 par exemple, (j'ai revu le code au passage)

Code:

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
Sub Macro2_save()
Dim Plage As Range
Dim Types$, Client$, Fichier$, Numfact$, Jour$, Facturation$, Client1$, Image$
Const Chemin1 = "i:\MENU_Factures\"
Const Chemin2 = "F:\Users\Christ\Desktop\MENU_Factures\"
Const Chemin3 = "F:\Users\Christ\Desktop\MENU_Factures\"
Const Chemin4 = "i:\MENU_Factures\"
 
Application.ScreenUpdating = False
With Sheets("Facture")
    Jour = Format(Now, "ddmmyyyy")
    Client = .Range("C4")
    Client1 = .Range("A1")
    Numfact = .Range("C3")
    Types = .Range("B3")
    Facturation = .Range("A1")
    Facturation = Facturation & ".xlsm"
 
    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
    ThisWorkbook.SaveAs Chemin1 & Client & "\" & Fichier
 
    ' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur l'ordi bureau
    If Dir(Chemin2 & Client1, 16) = "" Then MkDir Chemin2 & Client1
    ThisWorkbook.SaveAs Chemin2 & Client1 & "\" & Client1
 
    ' Enregistrement sur ordi maison dossier client
    If Dir(Chemin3 & Client, 16) = "" Then MkDir Chemin3 & Client
    ThisWorkbook.SaveAs Chemin3 & Client & "\" & Fichier
 
    ' Ecrasement de" 1 - Menu de Facturation Radio Pluriel.xlsm" sur la clé USB
    If Dir(Chemin4 & Client1, 16) = "" Then MkDir Chemin4 & Client1
    ThisWorkbook.SaveAs Chemin4 & Client1 & "\" & Client1
 
    Set Plage = .Range("B1:G51")
    Plage.CopyPicture
    With .ChartObjects.Add(0, 0, Plage.Width + 5, Plage.Height + 5).Chart
        .Paste
        .Export Chemin2 & Client & Image
    End With
    .ChartObjects(.ChartObjects.Count).Delete
End With
MsgBox "Numérisation de la facture terminée"
Set Plage = Nothing
End Sub

bonsoir,

merci pour tes corrections, elles sont beaucoup plus simple.

le fichier ce créer bien comme il le faut , mais il faudrait qu'il s'enregistre dans le dossier du client et pas dans le dossier ou se trouve tout les dossier client, c'est a dire que quant il créer le fichier .jpg il faudrait qu'il s'enregistre dans le chemin du dossier clien qui vient de se créer.
peut tu me trouver une solution

merci beaucoup pour se super travail

21/09/2010, 23h43
mercatog

Et quel est ce dossier client?

Edit
j'ai édité le code, un "\" entre le dossier et le fichier image.

je redit encore, à toi de remplacer dans la ligne ci-dessous Chemin2 & Client & "\" par le dossier que tu veux

Code:

.Export Chemin2 & Client & "\" & Image
22/09/2010, 15h40
djflnj

Bonjour,

Voila , tout est bon maintenant tout s'enregistre bien dans les bons dossiers aussi bien le fichier xlsm, le xls et le jpg merci à toutes les personnes qui n'ont donné de leurs temps et de leurs patiences.

Mais il y a de nouveau une option que je voudrais rajouter à mon projet,
celle de rajouter en même temp que l'enregistrement des autres fichiers xlsm, xls et jpg, que mon fichier s'enregistre de la même manière que les autres, mais en PDF et que se PDF soit mis automatiquement dans Outlook en pièce jointe, de même que l'adresse mail soit mis également automatiquement dans la zone d'envoi du mail dans Outlook.

Cordialement.
22/09/2010, 15h47
mercatog

Clos se sujet avec Résolu. et ouvre un autre avec les nouvelles questions. comme ça, ça sera profitable pour tout le monde.