Problème lors de l'export de photo

Question

Bonjour (yg_be),

Je fais de nouveau appel à votre aide pour un problème qui arrive lors d'un export de photo au format jpeg.

La photo créée contient deux lignes grises que je ne souhaiterais pas avoir.

Voilà à quoi cela doit ressembler :


Voilà ce que j'obtiens : (bizarrement, lorsque j'ajoute le fichier jpg directement au forum les lignes grises ne s'affichent pas ...)


Et voilà mon code :
Sub exportphoto()

Dim cht As ChartObject
Dim ActiveShape As Shape
Dim simple As Range, doublev As Range, triplev As Range, quadruplev As Range, doubleh As Range, tripleh As Range, quadrupleh As Range
Dim refp As String, refm As String

Set simple = Sheets("Configurateur").Range("R2:R10")
Set doublev = Sheets("Configurateur").Range("R2:R14")
Set triplev = Sheets("Configurateur").Range("R2:R22")
Set quadruplev = Sheets("Configurateur").Range("R2:R30")
Set doubleh = Sheets("Configurateur").Range("R2:T10")
Set tripleh = Sheets("Configurateur").Range("R2:V10")
Set quadrupleh = Sheets("Configurateur").Range("R2:X10")

refp = Sheets("Configurateur").[D7]
 refm = Sheets("Configurateur").[D15]

If Sheets("Configurateur").[G5] = "1C" Then
    simple.Copy
    
    ElseIf Sheets("Configurateur").[G5] = "2V" Then
        doublev.Copy
    
    ElseIf Sheets("Configurateur").[G5] = "3V" Then
        triplev.Copy
    
    ElseIf Sheets("Configurateur").[G5] = "4V" Then
        quadruplev.Copy
    
    ElseIf Sheets("Configurateur").[G5] = "2H" Then
        doubleh.Copy
    
    ElseIf Sheets("Configurateur").[G5] = "3H" Then
        tripleh.Copy
    
    ElseIf Sheets("Configurateur").[G5] = "4H" Then
        quadrupleh.Copy
        
End If

ActiveSheet.Pictures.Paste(link:=False).Select
  Set ActiveShape = ActiveSheet.Shapes(ActiveWindow.Selection.Name)

Set cht = ActiveSheet.ChartObjects.Add( _
    Left:=ActiveCell.Left, _
    Width:=ActiveShape.Width, _
    Top:=ActiveCell.Top, _
    Height:=ActiveShape.Height)

cht.ShapeRange.Fill.Visible = msoFalse
  cht.ShapeRange.Line.Visible = msoFalse

ActiveShape.Copy
  cht.Activate
  ActiveChart.Paste

cht.Chart.Export "C:\Users\boss-\Downloads\" & "probleme" & ".jpg"

cht.Delete
  ActiveShape.Delete

End Sub

Autre chose, deux lignes du code sont sensés enlever les grilles de la feuille, or quand j'active les grilles sur mon excel et que je relance la marco, les grilles apparaissent sur la photo. Ce n'est pas derangeant puisque je vais les laisser enlevées, mais cela m'intrigue.

Merci d'avance !

Bonne soirée !

cs_Le Pivert · Answer

Bonjour,

As-tu essayé de supprimer toutes les shapes avant de lancer ta macro?

Sub supprimershape()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
    sh.Delete
Next
End Sub



et pour cela:

Autre chose, deux lignes du code sont sensés enlever les grilles de la feuille, or quand j'active les grilles sur mon excel et que je relance la marco, les grilles apparaissent sur la photo 

Sub supprimerquadrillage()
ActiveWindow.DisplayGridlines = False
End Sub
Sub rétablir()
ActiveWindow.DisplayGridlines = True
End Sub

Problème lors de l'export de photo

1 réponse

Votre réponse

Discussions similaires

Newsletters