Export sous forme d'image

Invité · 19/04/2018, 11h34

Salut Patrick et Pijaku.

Pour Patrick : La première image est générée mais elle est vide.
Pour Pijaku : Tu as fait un essai sur Excel 2016 ? Je n'ai pas le temps dans la journée, je teste dès que je peux.

**pijaku** · 19/04/2018, 11h53

Bonjour Eric,

Je ne peux pas tester avant ce soir.

Pour être tout à fait honnête et complet, j'ai trouvé cette solution ICI sur social.msdn.microsoft.com

**patricktoulon** · 19/04/2018, 14h08

re
ok donc si l'image est blanche le .paste ne fonctionne pas ce qui veux dire que meme avec l'api dans le do/loop le clipboard de contient pas encore les information de l'image ou le paste n'atteint pas le chart
mais qu'est ce qui ont foutus che MS avec 2016?

**Pierre Fauconnier** · 19/04/2018, 14h23

Envoyé par patricktoulon

re
ok donc si l'image est blanche le .paste ne fonctionne pas [...]

Si, le Paste fonctionne, mais uniquement en pas à pas et l'image créée est conforme à la plage voulue. Si on met un point d'arrêt sur le paste puis qu'on avance avec F8, le fichier image est correctement créée.

**unparia** · 19/04/2018, 14h53

Je regrette terriblement de ne pas avoir sous la main la configuration incriminée (version Office, etc ...)
Je vais donc essayer de collaborer en aveugle, sur la seule base de mes connaissances des comportements, notamment lorsqu'il s'agit des affichages graphiques.
J'ai une question à poser à PhilippeF75 (et serais reconnaissant à toute autre participant de ne pas intervenir à propos du bien ou mal fondé supposé de cette question) :
A philippeF75, donc :
dans la procédure dans laquelle sont écrites ces deux lignes de code :

Code :

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

1
2
3
4
With Chart1
                .Paste
                .Export Chemin & NomImage, "jpg"
 End With

y as-tu également mis ensuite l'ouverture d'une msgbox, d'une inputbox ou de n'importe quelle boîte de dialogue ?
Si oui : montre cette ligne de code également (en la situant par rapport aux lignes de code que tu nous as montrées).

**patricktoulon** · 19/04/2018, 15h23

ok pierre je pense avoir compris ce qui se passe

j'ai eu un probleme similaire
lors de la copy le clipboard se vide de ce qui etait et se rempli avec les données de la copy
j'ai du genérer une attente du clipboard vide puis l'attente du cliboard plein mais cela c'etait avec le sendkey snapshot qui est plus lent que copypicture
en attendant que je retrouve ca
testez celui la avec un seul chart le temps d'execution du delete et add entre deux copy est supprimé comme ca

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
Option Explicit
#If VBA7 Then
    Private Declare ptrsafe Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
#Else
    Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
#End If
Sub exporte_image()
    Dim Plage As Range, chart1 As Object, i As Long, mesplage As Variant, hPicAvail As Long
    With Sheets("Feuil1")
        mesplage = Array("A2:K68", "A69:K180")
        Set chart1 = .ChartObjects.Add(0, 0, 1, 1).Chart
        For i = 0 To UBound(mesplage)
            With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With    'on vide le clipboard entre chaque copie pour tester vraiment le available
            Set Plage = .Range(mesplage(i))
            With chart1
                With .Parent
                    .Width = Plage.Width: .Height = Plage.Height: .Left = Plage.Width + 20:
                    Plage.CopyPicture
                    Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(14): Loop While hPicAvail = 0    'Or (Timer - T) > 1000
                    .Select
                    .Chart.Paste
                    .Chart.Export Environ("userprofile") & "\Desktop\image_" & i & ".jpg", "jpg"
                    .Chart.Pictures(1).Delete    'on delete a chaque fois l'image collée (important si les plages capturées sont differentes en terme de dimension)
                End With
            End With
        Next
        chart1.Parent.Delete
    End With
End Sub

pour les puristes remplacer ".select" par ".activate"

EDIT;

ca va vous paraitre ridicule mais je donne quand meme
entre la ligne 21 et 22 ajouter ceci puisque le pâste fonctionne en pas a pas

Code :

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

Do: DoEvents: Loop While .Chart.Pictures.Count = 0

**PhilippeF75** · 19/04/2018, 17h54

Bonjour, (Ce message s'est croisé avec le dernier de Patrick ; je vais essayer la solution proposée. Résultat : cette boucle ne s'arrête pas non plus...)
Comme je le précisais dans ma question d'origine, il semble que le Paste n'ait pas le temps de s'exécuter en mode automatique.
Voici mon code (qui fonctionnait avec Excel 2010) qui me permet de créer et de sauvegarder l'image d'un shape. (NB : il n'y a pas de MsgBox ici ou ailleurs dans ma procédure)
Je m'en sers pour créer des petites animations techniques pour mon site.
Un schéma technique est composé de plusieurs shapes que j'anime grâce à des routines spécifiques et après chaque mouvement, "je prends la photo" de l'ensemble des shapes regroupés dans un seul shape créé pour l'occasion et nommé "Groupe A". Enfin, avec tous les fichiers créés, grâce à "GIF Movie Gear", j'obtiens une animation gif que je place sur mon site.

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 CaptureImage(strChemin As String, strFichierNomPrefixe As String, intNum As Integer)
' Créé et sauvegarde l'image du Shape nommé "Groupe A"
' Paramètres :
' - strChemin = répertoire du fichier image créé
' - strFichierNomPrefixe = préfixe du nom du fichier image à créer
' - intNum = numéro de l'image
 
  ' Déclaration des variables
  Dim shpCadre As Shape, chtChart As Chart
  Dim strPictureNum As String, strPictureNom As String
 
  ' Définition des variables
  Set shpCadre = ActiveSheet.Shapes("Groupe A")
  strPictureNum = "000"
  Mid(strPictureNum, 4 - Len(Trim(CStr(intNum)))) = Trim(CStr(intNum))
  strPictureNom = strChemin & strFichierNomPrefixe & strPictureNum & ".png"
 
  ' Création de l'image dans un chart, sauvegarde, suppression du chart et dégroupage des shapes
  With ActiveSheet
    shpCadre.CopyPicture
    Set chtChart = .ChartObjects.Add(shpCadre.Left, shpCadre.Top, shpCadre.Width, shpCadre.Height).Chart
    With chtChart
      .Paste
      '.Activate
      'Do
        'DoEvents
        'hPicAvail = IsClipboardFormatAvailable(2)
      'Loop While hPicAvail = 0
      .Export strPictureNom, "PNG"
    End With
    .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
    Set chtChart = Nothing
    .Shapes("Groupe A").Ungroup
  End With
 
End Sub

Vous noterez les essais faits (la boucle avec IsClipBoardFormatAvailable qui ne fonctionne pas et le Activate qui génère une erreur).

**patricktoulon** · 19/04/2018, 18h19

re
teste le poste 26 avec l'ajout de la ligne comme precisé
si il y a erreur quelle ligne ?
et fait moi plaisir pour hotter tout doute fait le test dans un fichier vierge

d'autant plus que

Code :

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

strPictureNom = strChemin & strFichierNomPrefixe & strPictureNum & ".png"

nan nan!!! png pas bon c'est bitmap,jpg,ou gif et c'est tout meme si ca te parrais bon les metadonnées ne correspondront pas au format du fichier

**Pierre Fauconnier** · 19/04/2018, 19h15

J'ai essayé pour ma part les solutions de Franck. Rien n'y a fait.

On dirait qu'il faut vraiment une interruption du process, car en mettant un point d'arrêt puis en lançant avec deux F5 pressés coup sur coup, l'arrêt est très bref et l'image est bien créée.

**PhilippeF75** · 19/04/2018, 19h37

Envoyé par Pierre Fauconnier

J'ai essayé pour ma part les solutions de Franck. Rien n'y a fait.
On dirait qu'il faut vraiment une interruption du process, car en mettant un point d'arrêt puis en lançant avec deux F5 pressés coup sur coup, l'arrêt est très bref et l'image est bien créée.

J'en arrive à la même conclusion.
Je vais faire le test proposé par Patrick.

SUPER ! J'ai créé un nouveau dossier Excel avec une seule feuille et fait un copier-coller du code proposé par Patrick (légèrement modifié quant aux plages à traiter) et les deux images ont bien été créées et posées sur le bureau.
Donc ça marche ainsi. Il reste à truover pourquoi ça ne marche pas avec mon fichier.

**patricktoulon** · 19/04/2018, 20h33

ok super d'accords
a tu a jouté la ligne entre la 21 et 22 comme je le dit dans le post ???c'est important pour ce dont je doute

**pijaku** · 19/04/2018, 20h36

@Pierre :
En effet, cela ne fonctionne pas.

@Jacques :
J'ai tenté une boucle DoEvents de 3 secondes avant et après le Paste, cela ne fonctionne pas non plus.

Un beau gros bug quoi.
Je vous laisse en vous lisant car je n'ai rien de plus à proposer.
A++

**PhilippeF75** · 19/04/2018, 20h55

Merci Patrick !
J'ai repris mon fichier d'origine dans lequel j'ai modifié ma routine de la façon suivante :
- ajout du vidage du presse-papier
- ajout de la boucle test IsClipboardFormatAvailable(14)<>0
- ajout de la boucle test .Chart.Pictures.Count<>0
- mais surtout, et je crois que la solution était là, ajout de .Parent
C'est ce dernier point qui constitue la vraie différence entre les deux codes, celui qui marchait sous Excel 2010 mais pas sous Excel 2016 et celui qui marche sous Excel 2016.
La question qui reste posée : Pourquoi cette différence ?
La nouvelle routine est donc :

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
45
46
 
Sub CaptureImage(strChemin As String, strFichierNomPrefixe As String, intNum As Integer)
' Créé et sauvegarde l'image du Shape nommé "Groupe A"
' Paramètres :
' - strChemin = répertoire du fichier image créé
' - strFichierNomPrefixe = préfixe du nom du fichier image à créer
' - intNum = numéro de l'image
 
  ' Déclaration des variables
  Dim shpCadre As Shape, chtChart As Chart
  Dim strPictureNum As String, strPictureNom As String
 
  ' Définition des variables
  Set shpCadre = ActiveSheet.Shapes("Groupe A")
  strPictureNum = "000"
  Mid(strPictureNum, 4 - Len(Trim(CStr(intNum)))) = Trim(CStr(intNum))
  strPictureNom = strChemin & strFichierNomPrefixe & strPictureNum & ".png"
 
  ' Vidage du presse-papier
  With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
 
  ' Création de l'image dans un chart, sauvegarde, suppression du chart et dégroupage des shapes
  With ActiveSheet
    Set chtChart = .ChartObjects.Add(0, 0, 1, 1).Chart
    shpCadre.CopyPicture
    Do: DoEvents: hPicAvail = IsClipboardFormatAvailable(14): Loop While hPicAvail = 0
    With chtChart
      With .Parent
        .Width = shpCadre.Width
        .Height = shpCadre.Height
        .Activate
        With .Chart
          .Paste
          Do: DoEvents: Loop While .Pictures.Count = 0
          .Export strPictureNom, "PNG"
          .Pictures(1).Delete
        End With
      End With
    End With
    .ChartObjects(ActiveSheet.ChartObjects.Count).Delete
    .Shapes("Groupe A").Ungroup
    Set chtChart = Nothing
    Set shpCadre = Nothing
  End With
 
End Sub

**unparia** · 19/04/2018, 21h05

Ouais ...
Plus je lis tous les messages, plus je commence à penser que le stop (qui, utilisé, permet la complétion graphique du Paste), plus je pense que des messages système sont encore en cours de traitement entre Paste et Export.
Tenter l'utilisation de la fonction RedrawRepaint ? -->> je ne crois personnellement pas que cela soit un vrai remède. Je chercherais plutôt à temporiser cette mise à jour par utilisation de la fonction InvalidateRectLong de la librairie user32 de l'api de windows, dont l'effet serait de mettre à jour la fenêtre graphique dès réception d'un message système WM_PAINT message. L'effet n'est pas immédiat, mais il sera forcément là à un moment ou à l'autre. On peut le provoquer si l'on agit par exemple sur la position d'une fenêtre. C'est par exemple ce que j'ai choisi de faire dans une autre discussion récente (Un Frame Transparent avec VBA/Excel).
Tenter cela. C'est peut-être une solution à ce problème purement graphique.
Une telle solution implique toutefois un liminaire : l'extraction nécessaire du handle de la fenêtre concernée .
C'est du boulot .

**patricktoulon** · 19/04/2018, 21h20

non c'est pas le .parent mais bel et bien l'indisponibilité du chart entre 2 copy add chart et delete j'ai testé sur le portable du minot

ce qui est etonant dans mon ancien exemple et les votres (1 chart par copie) c'est que si j'arrette la boucle a for i= 0 to 0 donc un seul tour l'image est bonne

si il y a plusieur plage le fait de ajouter le chart paster,exporter,deleter et plus gourmand pour les fois suivantes la premieres( quelque chose ne se vide pas en memoire on dirait )

d'ou mon idée d'en créer qu'un et de simplement pastersur le chart , exporter ,deleter l'image collée (en réadaptant ses dimentions pour chaque plage )

visiblement sur PC portable W10 excel 2016 ca marche

le minot m'a traité de tout les noms d'oiseaux j'ai fermé involontairement ses jeux facebook

puré qué farce ce W10

**PhilippeF75** · 19/04/2018, 21h23

OK, bien vu.
Merci encore Patrick.
Je coche "résolu"
à une prochaine fois...

**patricktoulon** · 19/04/2018, 21h37

il serait interessant de faire a la place d'un do loop un retardateur avec api settimer/killtimer qui est non bloquant et se serait le timer qui executerait le paste ,export,delete

et pour savoir si c'est le clipboard qui a un coup de mou dans 2016
dans une boucle fait le test copypicture-> activesheet.paste sur differente plage et controle les image dans le sheets si tu les a toute c'est bien le chart le coupable il est bien indispo tout de suite apres le add

**patricktoulon** · 19/04/2018, 21h42

de rien

je decouvre en meme temps que toi et les autres

n'ayant pas 2016 sur mes PC je l'ignorais completement

si pierre ou unparia veulent en faire une contrib avec test poussé je les encourage p

erso mes possibilité de tests sur 2016 sont nulle jusqu'a temps que le minot oubli ma gaffe

**pijaku** · 19/04/2018, 21h44

Juste comme ça, je vais certainement dire une bêtise mais j'y vais....
Et si la faute n'était pas le Paste mais le CopyPicture.
C'est possible non?

**patricktoulon** · 19/04/2018, 22h01

re
franck c'est toujours pareil fait le test copypicture paste sur sheets tu aura ta reponse c'est comme ca que j'ai decouvert ou ca clochait (par élimination)

Export sous forme d'image [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager