XL 2019 macro prendre en photo un tableau à l'instant T

[akujah]

Bonjour,

J'essaye de réaliser un fichier pour le suivi des dépenses. Une base de données avec toutes les dépenses ligne par ligne, et une feuille RECAP avec un somme.si par nature de dépense.
J'aimerais bien à la fin du mois avoir une macro qui me copie/colle le tableau recap figé (avec un histogramme) sur le côté pour garder un historique. Mon code ressemble à ca pour l'instant mais une erreur 'L'élément portant ce nom est introuvable' s'affiche. Pouvez vous m'aider svp ?

Sub VALIDATION()
'
' VALIDATION Macro
'

'
Columns("A:E").Select
Selection.Copy
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

ActiveSheet.ChartObjects("Graphique 27").Activate
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.ChartArea.Select
Application.CutCopyMode = False
ActiveChart.Parent.Cut
Range("I30").Select
ActiveSheet.PasteSpecial Format:="Image (PNG)", Link:=False, DisplayAsIcon _
:=False
End Sub

 

[Compte Supprimé 979]

Bonjour Akujah

Un truc du style

Sub Export()
Application.ScreenUpdating = False
    On Error GoTo ExportErreur

Dim Plage As Range
Dim FichierImage As Variant

Dim Titre As String
Titre = InputBox(Prompt:="Ajouter un titre à l'export ? (facultatif)")
Cells(2, 12) = Titre

Set Plage = Range("A2:W20").Cells
Plage.CopyPicture Appearance:=xlScreen, Format:=xlPicture

With ActiveSheet.ChartObjects.Add(Left:=Plage.Left, Top:=Plage.Top, Width:=Plage.Width, Height:=Plage.Height)
    .Name = "ExportImage"
    .Activate
End With
ActiveChart.Paste

FichierImage = Application.GetSaveAsFilename(InitialFileName:=Titre, FileFilter:="Image file (*.png), *.png")
If FichierImage <> False Then
    ActiveSheet.ChartObjects("ExportImage").Chart.Export FichierImage
End If
ActiveSheet.ChartObjects("ExportImage").Delete
Cells(2, 12) = ""

Application.ScreenUpdating = True
Exit Sub
ExportErreur:
    MsgBox "Une erreur est survenue..."
    Application.ScreenUpdating = True
End Sub

A adapter à votre besoin

 

[job75]

Bonjour akujah, Bruno,

Attention, sur les versions Excel récentes cette instruction :

ActiveChart.Paste

ne s'exécute pas toujours, il faut la forcer par une boucle d'attente :

While ActiveChart.Shapes.Count = 0
    ActiveChart.Paste
Wend

A+

 

[patricktoulon]

re bonjour
et encore ca marche pas toujours la boucle d'attente sur 2016( sur mon petit portable)
car la latence du clipboard est en lecture mais aussi en écriture
et des que le début de l'image est digérée par le clipboard c'est a dire un rectange blanc la boucle lache alors que les data de l'image ne sont pas complètes dans le clipboard