Artfact etrange

Hello les amis.

En utilisant ce code

Dim rngToPNG As Range           ' La plage à enregistrer
Dim booGrid As Boolean          ' Pour rétablir la grille telle qu'elle
Dim varExportPath As Variant    ' Chemin complet d'enregistrement de l'image

' Sélection de la plage de cellule
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

' Demande à l'utilisateur le chemin où enregistrer l'image

    varExportPath = Application.GetSaveAsFilename(ActiveWorkbook.Path & "\image.png", "Image (*.png),*.png", , "Enregistrer sous forme d'image")
If varExportPath <> False Then

    ' Masquer les coulisses
    Application.ScreenUpdating = False              ' Figer l'écran
    booGrid = ActiveWindow.DisplayGridlines         ' Mémoriser la grille
    ActiveWindow.DisplayGridlines = False           ' Masquer la grille

    ' Mémoriser la zone sélectionnée par l'utilisateur
    Set rngToPNG = Selection

    ' Sélectionner une cellule très loin du tableau pour être sûr que la création de la zone de graphique soit vide
    Range("A1").SpecialCells(xlLastCell).Offset(5, 5).Select

    ' Création d'une zone de graphique et sélection de celle-ci
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ' Redimentionnement à la taille de la zone de cellules
    ActiveSheet.Shapes(1).Height = rngToPNG.Rows.Height
    ActiveSheet.Shapes(1).Width = rngToPNG.Columns.Width
    ' Copier la zone de cellules sous forme d'image
    rngToPNG.CopyPicture xlScreen, xlPicture
    ' Collage dans la zone de graphique
    ActiveChart.Paste

    ' Export sous forme d'image
    ActiveChart.Export Filename:=varExportPath, FilterName:="PNG"

    ' Retour à la normale
    ActiveSheet.Shapes(1).Delete
    rngToPNG.Select
    ActiveWindow.DisplayGridlines = booGrid
    Application.ScreenUpdating = True

    ' Confirmation
    MsgBox "L'image a bien été enregistrée...", vbInformation
End If

Je me retrouve avec des images qui ont des artefacts étranges (Comme s'il printscreenais un bout de fenêtre...) une idée ?

2020 06 30 16h20 12

Salut Djulito

Le code copie ce qui se trouve dans ta fenêtre Excel

rngToPNG.CopyPicture xlScreen, xlPicture

Donc effectivement, si ta zone graphique chevauche une partie ou se trouvent des cellules remplies, tu auras le fond d'écran (cellules) qui apparaitra

@+

Bonjour Djulito, BrunoM45,

Pour ne pas rester dans le flou. Rappel du sujet Exporter Photo

Salut Djulito

Le code copie ce qui se trouve dans ta fenêtre Excel

rngToPNG.CopyPicture xlScreen, xlPicture

Donc effectivement, si ta zone graphique chevauche une partie ou se trouvent des cellules remplies, tu auras le fond d'écran (cellules) qui apparaitra

@+

Merci ! saurais tu comment résoudre cela ?

Merci d'avance ;)

Ce quie st bizarre c'est que j'ai pas de zone graphique et que ca change selon l'ordi…

2020 07 08 11h10 41 2020 07 08 11h12 46

Bonsoir

Et en supprimant cette ligne

Application.ScreenUpdating = False              ' Figer l'écran

@+

Ca a l'air de marcher pour le moment ! Merci beaucoup !

Rechercher des sujets similaires à "artfact etrange"