Discussion :

[Pasfortiche]

Bonjour,
Premier post pour moi autodidacte...

Voilà un bout de "code":

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    Valeur = Range("H2").Value
    Dim S As Range
    Set S = Sheets("Classement Championnat").Range("A1", "G" & Valeur)
    S.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
 
    Application.ScreenUpdating = True
    Workbooks.Add
 
    With ActiveSheet.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
    .Paste
    .Export "C:\***.png", "PNG"
    End With
 
    ActiveWorkbook.Close False

Alors voilà, je sèche totalement car voyez-vous en pas à pas dans le débogueur pas de soucis j'ai mon image enregistré sur le disque ...
Mais lors de l'exécution du bouton affecté à cette macro l'export copie une image vide (toujours enregistré sur le disque)

Pourquoi dieu cela fonctionne-t-il en pas à pas et pas après Grrr!
Help please.
Merci par avance !

[patricktoulon]

bonjour
je parie a 10 contre 1 que tu tourne sur 2013 ou 2016 ou plus
inspire toi de cela
https://www.developpez.net/forums/d1...-excel-2016-a/

[Menhir]

Juste avant ton Set S =, mets un MsgBox(ActiveWorkbook.Name) pour vérifier que c'est au bon classeur que la Sheet qui suit est liée.

[Pasfortiche]

Alors merci pour ces infos, utiles dans le sens où elles m'ont conforté dans le fait qu'il s’agissait bien d'un soucis de "Timing" (désolé je parle avec mes mots)

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
...
    Valeur = Range("H2").Value
    'Range("A1", "G" & Valeur).Select
    'Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    Dim S As Range
    'MsgBox (ActiveSheet.Name)
    Set S = Sheets("Classement Championnat").Range("A1", "G" & Valeur)
    S.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
 
    Application.ScreenUpdating = False
    Workbooks.Add
    With ActiveSheet.ChartObjects.Add(0, 0, S.Width, S.Height).Chart
    DoEvents
    DoEvents
    DoEvents
    DoEvents
    DoEvents
    .Paste
    .Export "C:\Users\Papa\Desktop\ExtractionClassementChampionnat.png", "PNG"
 
    End With
 
    ActiveWorkbook.Close False
...

le do: Until: ... ne fonctionne pas chez moi
3 constatations:
1) c'est avant le Paste qu'il y avait soucis
2) j'ai besoin de 4/5 DoEvents pour que cela passe
=> merci de me dire si possible comment simplifier ça sans rien modifier du reste du code, j'entends par là ne pas toucher à mon With ActiveSheet.ChartObjects.Add(0, 0, S.Width, S.Height).Chart.
3) si le Application.ScreenUpdating est sur False (permet d'accélérer la macro) et bien c'est KO également donc bien mettre = True.

[Pasfortiche]

Ceci étant quasi résolu, mon second objectif serait de récupérer (tjrs en VBA depuis le même simple bouton sur page Excel)
ce même fichier tout fraîchement exporté sur mon disque pour utiliser un hébergeur d'images tel que sur goopics.net qui n'accepte que le glisser/coller ou la recherche de l'emplacement disque et de lui demander de me créer un URL de cette image.

Le troisième objectif sera d'aller récupérer cet URL et juste me le mettre dans le presse papier (mais ça je dois et devrais y parvenir)...

Si il y a plus simple du style Excel qui créerait des URL pour stocker une image jsuis preneur mais jpense pas hein

Si qq'un à un lien d'études déjà faites pour la récup d'un fichier sur "emplacement disque et glisser coller sur zone web" bah je veux bien hihi

Merci encore !!!

[patricktoulon]

re
résolu c'est vite dit
tes doevents sont suffisant aujourd'hui mais demain si ton pc fait des taches en arrière plan ou sur un autre pc moins puissant pourrait même provoquer un white-screen
et ben la tu sera chocolat

je t'ai adapté une petite fonction par rapport a ma contribution

le principe comme je le dit c'est d'interroger le clipboard dans un do loop pour savoir si les data corresponde au format xlpicture
l'attente est juste ce qui faut puisqu'on sort du do:loop quand le clipboard est prêt

tu peux copier une plage ou une shapes tu a les deux

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
 
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
 
Function Copy_All_To_Fichier(obj As Variant, desti As String)
    Dim hPicAvail&, i&
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With    'on vide le clipboard entre chaque copie pour tester vraiment le available
    Application.ScreenUpdating = False
    obj.CopyPicture    'Appearance:=xlScreen, Format:=xlBitmap
    Do: i = i + 1: DoEvents: hPicAvail = IsClipboardFormatAvailable(14): Loop While hPicAvail = 0 Or i = 5000
   If hPicAvail = 0 Then MsgBox "le clipboard n'a pas d'image": ActiveWorkbook.Close False
        Workbooks.Add
    With ActiveSheet.ChartObjects.Add(0, 0, obj.Width, obj.Height).Chart
        .Paste:
        Do: DoEvents: Loop While .Pictures.Count = 0
         .Export desti, UCase(Mid(desti, InStrRev(desti, ".") + 1))
    End With
    ActiveWorkbook.Close False
End Function

deux subs pour la tester

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
 
Sub test_copie_Range()
    Dim valeur, s As Range, chemin$
    valeur = 10    'Range("H2").Value
    chemin = "C:\Users\polux\Desktop\ExtractionClassementChampionnat.png"
    Set s = Sheets(1).Range("A1", "G" & valeur)
    Copy_All_To_Fichier s, chemin
End Sub
'
Sub test_copie_shape()
    Dim valeur, s As Variant, chemin$
    chemin = "C:\Users\polux\Desktop\mashape.png"
    Set s = Sheets(1).Shapes("Ellipse 1")
    Copy_All_To_Fichier s, chemin
End Sub