Bonjour,

J'ai récupéré un bout de code sur le site de
http://boisgontierjacques.free.fr/

Jacques Boisgontier - Export image interne en gif"]Export image interne en gif
C'est une boucle qui dépose une image sauvegardée à chaque passage.
lorsque j'exécute en pas à pas je récupère bien mes fichiers, quand je le lance, il s'exécute mais ne sauvegarde rien.

il faut surement activer quelquechose ?

En fait la fonction boucle sur ExportImage
C'est le doevents qui boucle.
et si je l'enlève, je perds la main sur Excel of course.

J'ai essayé d'encadrer la boucle while mais j'ai toujours shapes.count = 0
J'ai lu la doc doevents de MS, mais je n'ai pas compris (pas su interpréter l'explication)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
     While .Shapes.Count = 0
     MsgBox .Shapes.Count  'm'affiche 0
       DoEvents
       .Paste
      MsgBox .Shapes.Count   m'affiche 0
     Wend

Code complet avec l'appel


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
38
39
40
41
42
43
44
 
Option Explicit
Public Ws_Etiq As Worksheet
Public Ws_Abaque As Worksheet
Public L_Abaq
Public Lab_Indice
Sub Label_print()
 
Set Ws_Abaque = ThisWorkbook.Sheets("Saisie_Abaque")
Lab_Indice = Format(1, "00")
 
L_Abaq = 7
' je boucle sur les infos saisies en colonne K
While Not IsEmpty(Ws_Abaque.Range("K" & L_Abaq))
ExportImage
L_Abaq = L_Abaq + 9
Lab_Indice = Format(Lab_Indice + 1, "00")
' on met à jour l'index pour impression
Ws_Etiq.Range("B16") = L_Abaq
Wend
 
End Sub
Sub ExportImage()
Dim M_Printer, Repertoire, NomShape, Mon_Img, N_OF, Nom_Label
Set Ws_Etiq = ThisWorkbook.Sheets("Etiquette")
 
M_Printer = Ws_Etiq.Range("B17")
N_OF = Ws_Etiq.Range("M2")
 
  Repertoire = "C:\Users\MOI\Desktop\"     '"ThisWorkbook.Path & "\"
  Nom_Label = "Abaque_" & M_Printer & "_" & N_OF & "_" & Lab_Indice
  NomShape = "Image_Label"
  Set Mon_Img = Ws_Etiq.Shapes(NomShape)
  Mon_Img.CopyPicture xlScreen, xlBitmap
  With Mon_Img.Parent.ChartObjects.Add(0, 0, Mon_Img.Width, Mon_Img.Height).Chart
'  With img.Parent.ChartObjects.Add(0, 0, 359, 181).Chart
     While .Shapes.Count = 0
       DoEvents
       .Paste
     Wend
     .Export Repertoire & Nom_Label & ".jpg", "jpg"
     .Parent.Delete
  End With
End Sub
Merci
Denis