Copier exporter en boucle plusieur plage en fichier image avec un graph methode valable pour excel 2016
Bonjour a tous
tout le monde sait exporter une plage en image a l'aide d'un chart(graphique)
jusqu'a 2010 on pouvait boucler sur x plage copier la plage,creer un graph ,coller ,exporter,deleter le graph
il se trouve qu'avec 2016 le graph n'est pas disponible juste apres sa création la raison est encore en etude perso je n'ai pas encore trouvé
issu de cette discussion j'ai eu une idée
on ne créé qu'un seul graph avant la boucle ce qui laisse le temps a l'application de le mettre bien en place
et dans la boucle
- copier la plage avec copypicture
- dimensionner le graph a la dimension de la plage
- coller
- exporter
- suprimer le ".picture(1)" apres export
ce qui parait visiblement plus leger pour excel 2016
etant donné le probleme j'ai pensé aussi que la lenteur du clipboard deja connu sur des versions précedentes de excel pouvait aussi generer une erreur
j'ai donc ajouté une boucle d'attente sur le format attendu dans le clipbord malheureusement ici on utilisera une api dommage pour les réfracteres
pour encore plus de securité j'ai mis 2 boucles d'attente sur le .pictures.count du chart avant et apres paste de facon a ce que l'on ai une seule image dans le graph a chaque fois(tour)
apres tests il semblerait que ca fonctionne aussi bien sur 2007,2010,(2013 en attente de test ),2016
voici un exemple de copie de simultanée de deux plages differentes
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
| 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
Do: DoEvents: Loop Until .Chart.Pictures.Count = 0
.Chart.Paste
Do: DoEvents: Loop While .Chart.Pictures.Count = 0
.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 |
je ferait une fonction generique
je cherche encore le moyen sachant que le chart doit etre créé avant et qu'une seule fois plusieurs essais ont deja été fait mais ca ne me convient pas encore
- soit je fait une fonction avec injection d'un array de plage
- soit je fait une fonction avec creation du chart dédié ,si il n'existe pas deja et j'injecte une seule plage a la fois la boucle serait alors dans la sub d'appel de la fonction
vos opinions sur cette question m'interesse
EDIT:
premiere coquille(cheveux dans la soupe):
corrigez la ligne 17 pour celle ci
Code:
.Width = plage.Width: .Height = plage.Height: .Left =plage.left + plage.Width + 20:
en effet si la plage ne commence pas en colonne"A" on risque de capturer une partie du graph
