Sauvegarde capture

VBA
1

bonjour
j’ai cette macro qui fonctionne bien, mais il me sauvegarde en pdf mon fichier de capture
as t-il un moyen de changer pour le mettre en PNG
merci

Sub CapturerEtEnregistrer()

Dim ws As Worksheet
Dim rng As Range
Dim cheminFichier As String

' Définir la feuille "classement"
Set ws = ThisWorkbook.Sheets("classement")

' Définir la plage à capturer
Set rng = ws.Range("E1:H31")

' Changer le chemin du fichier selon votre besoin
cheminFichier = "D:\Documents\capture.png"

' Capturer la plage et l'enregistrer dans le dossier spécifié
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ThisWorkbook.Sheets.Add
    .Paste
    .ExportAsFixedFormat Type:=xlTypePNG, Filename:=cheminFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

' Supprimer la feuille temporaire
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

End Sub

2

Bonjour

Ce traitement semble fonctionner
Essaies et dis moi

Dim ws As Worksheet
Dim rng As Range
Dim cheminFichier As String

' Définir la feuille "classement"
Set ws = ThisWorkbook.Sheets("classement")

' Définir la plage à capturer
Set rng = ws.Range("E1:H31")

' Changer le chemin du fichier selon votre besoin
cheminFichier = "D:\Documents\capture.png"

' Capturer la plage et l'enregistrer dans le dossier spécifié
rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With ThisWorkbook.Charts.Add
    Application.Wait (Now + TimeValue("0:00:01"))
    .Paste
    .Export Filename:=cheminFichier, Filtername:="png"
End With

' Supprimer la feuille temporaire
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
3

bonjour FFO
ta solution fonctionne bien mais il me capture un graphique vierge en même temps
je te joint l’image qu’il me capture

capture bis
capture bis1152×753 12.4 KB

4

Merci pour ton retour
« mais il me capture un graphique vierge en même temps »

Dans ton image je ne vois pas de graphique

Il faut jouer sur cette ligne code pour cibler exactement la plage à capturer :

Set rng = ws.Range("E1:H31")

Mets les bonnes adresses pour capturer la bonne zone

5

les colonnes orange sont bien E1 : H31
et les lignes qu’on vois sur la droite font parti d’un graphique vierge qu’il me mets dans une feuille que la macro crée pour la capture

6

je te joins une capture pour que tu vois le graphique que je n’ai pas a chaque fois

classement du _2024 04 17_18 33 21
classement du _2024 04 17_18 33 211152×753 16 KB

7

Je pense que le graphique fait partie de la zone définie (« E1:H31 ») même si ses lignes qui débordent de celle-ci n’en fait pas
Un graphique etant une construction entière qui ne peut être morcelé la moindre parcelle de celui-ci prise dans la capture entraine l’intégralité de sa composition dans celle-ci
Pas d’autre choix

8

ok merci je vais voir si je peux faire autrement
merci pour ton aide
a bientot

9

Parfait
Merci de valider ma proposition un petit plus sympathique
Au plaisir

1 « J'aime »
10

il faut ralentir tout un petit peu, maintenant, c’est 300 msecondes dans la macro « Attendre »
si cela ne fonctionne pas augmenter vers 500 msec (=+0.5) ou …
s’il y a encore des problèmes ajoutez votre fichier

(PS. application.wait n’est pas assez précis)

Sub FFO()
     Dim ws    As Worksheet
     Dim rng   As Range
     Dim cheminFichier As String

     ' Définir la feuille "classement"
     Set ws = ThisWorkbook.Sheets("classement")

     ' Définir la plage à capturer
     Set rng = ws.Range("E1:H31")

     ' Changer le chemin du fichier selon votre besoin
     cheminFichier = "D:\Documents\capture.png"

     ' Capturer la plage et l'enregistrer dans le dossier spécifié
     rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
     With ThisWorkbook.Charts.Add
          Attendre
          .Paste
          Attendre
          .Export Filename:=cheminFichier, Filtername:="png"
          Attendre
     End With

     ' Supprimer la feuille temporaire
     Application.DisplayAlerts = False
     ActiveSheet.Delete
     Application.DisplayAlerts = True
End Sub

Sub Attendre()
     Dim t1, t2
     t1 = Timer
     t2 = Timer + 0.3                        'delai de 300 mseconde
     Do
          DoEvents
     Loop While t1 <= Timer And Timer <= t2
End Sub
11

bonjour Cow18
désolé je ne vois pas entre ralentir la macro et le graphique de la capture
car quand je mets ta macro , je me retrouve avec 2 macro

12

vous avez raison, il y a 2 macros, mais vous voyez aussi 3 lignes avec « Attendre » dans la première macro, c’est le moment que a première macro saute vers la 2eme et attend 300 msec, normallement suffisant pour faire une mise à jour de la ligne précédente.

1 « J'aime »