Pas à pas = OK, Automatique = NOK enregistrement image de plage de cellules

Bonjour,

voici mon code qui fonctionne en "pas à pas", mais ce dernier ne fonctionne pas en automatique :

Sub PhotoSauvegarde()
    Dim Graph As ChartObject, LeChemin As String, Source As Range
    LeChemin = ThisWorkbook.Path & "\" & _
                Format(Date, "yyyy-mm-dd") & "_" & Format(Hour(Time), "00") & "h" & Format(Minute(Time), "00") & "m" & Format(Second(Time), "00") & "s" & ".jpg"
    Set Source = Sheets("Feuil1").Range("A1:H20")
    Source.CopyPicture xlScreen, xlBitmap
    Set Graph = Sheets("Feuil1").ChartObjects.Add(0, 0, Source.Width, Source.Height)
    Graph.Chart.Paste
    Graph.Chart.Export LeChemin, "JPG"
    Graph.Delete
End Sub

A la main j'ai bien l'image, en automatique je n'ai qu'un rectangle blanc aux bonnes dimensions...

Le fichier exemple avec un enregistrement de l'image dans le dossier où se trouve le fichier Excel :

Auriez vous une astuce, ou bien voyez vous ce qui manque au code ? Merci.

@ bientôt

LouReeD

Bonjour LouReed,

Un petit coup de DoEvents peut-être ? (Juste après le CopyPicture)

A+

Bonjour galopin01,

j'ai essayé et cela ne marche pas, j'ai même essayé une pause avant l'export dans le cas où celui-ci serait "trop rapide" par rapport au PASTE, mais rien n'y fait.
je ne parle pas non plus des ScreenUpdating....

Il doit me manquer un truc...
j'ai même essayé avec un autre code que j'avais qui boucle sur le CHART en partant du "parent", alors soit je n'ai pas repris le code "mot pour mot" soit il ne fonctionne pas non plus, j'y retourne, j'ai un doute.

@ bientôt

LouReeD

Bon doute levé !

je n'avais pas du reprendre correctement le code, ci dessous il fonctionne :

Sub AvecParent()
    Dim Graph, LeChemin As String, Source
    LeChemin = ThisWorkbook.Path & "\" & _
               Format(Date, "yyyy-mm-dd") & "_" & Format(Hour(Time), "00") & "h" & Format(Minute(Time), "00") & "m" & Format(Second(Time), "00") & "s" & ".jpg"
    With Sheets("Feuil1")
        .Range("A1:H20").Copy
        .Pictures.Paste.Name = "Graph"
        Application.CutCopyMode = False
        Set Source = .Shapes("Graph")
        Source.CopyPicture xlScreen, xlBitmap
        With Source.Parent.ChartObjects.Add(0, 0, Source.Width, Source.Height).Chart
            While .Shapes.Count = 0
                DoEvents
                .Paste
            Wend
            .Export LeChemin, "JPG"
            .Parent.Delete
        End With
        .Shapes("Graph").Delete
    End With
End Sub

Mais toujours est-il que l'autre code fonctionne en pas à pas mais pas en auto !

@ bientôt

LouReeD

De retour,

changement de machine et le code fonctionne pas !
Je reprend l'idée de galopin01, j'ajoute un DoEvents mais avant le CopyPicture et cela fonctionne !

Le code final :

Sub AvecParent()
    Dim Graph, LeChemin As String, Source
    LeChemin = ThisWorkbook.Path & "\" & _
               Format(Date, "yyyy-mm-dd") & "_" & Format(Hour(Time), "00") & "h" & Format(Minute(Time), "00") & "m" & Format(Second(Time), "00") & "s" & ".jpg"
    With Sheets("Feuil1")
        .Range("A1:H20").Copy
        .Pictures.Paste.Name = "Graph"
        Application.CutCopyMode = False
        Set Source = .Shapes("Graph")
        DoEvents
        Source.CopyPicture xlScreen, xlBitmap
        With Source.Parent.ChartObjects.Add(0, 0, Source.Width, Source.Height).Chart
            While .Shapes.Count = 0
                DoEvents
                .Paste
            Wend
            .Export LeChemin, "JPG"
            .Parent.Delete
        End With
        .Shapes("Graph").Delete
    End With
End Sub

Merci Galopin01.

@ bientôt

LouReeD

Peut être également Refresh

et

!...

ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1

Bon ben sur un ultime test il me dit qu'il ne peut pas coller....

J'y retourne...

@ bientôt

LouReeD

Bon et bien voici ce qu'il en est :

Ouverture du fichier, lancement du code, collage pas possible.
Relance du code en pas à pas, il passe.
Relance du code en auto, il passe.

Fermeture du fichier.

Ouverture du fichier, lancement du code, il passe

Fermeture, ouverture ça passe...

Je vais mettre une gestion d'erreur dans le cas où cela ne passerait pas...
Merci pour tout.

@ bientôt

LouReeD