Bonjour à tous,
afin d'afficher sur un téléviseur une cartographie créée dans excel, j'utilise une macro qui copie en image une feuille excel et qui la colle dans une nouvelle.
Mon problème est que dans cette macro, quand je viens coller la nouvelle image, elle se superpose aux autres déja présentes (du fait d'une précédente utilisation) sur cette même feuille et du coup au bout d'un certain temps la macro plante:
Sub ImagePlageCellules()
' JLL Complet
Worksheets("JLL Complet").Unprotect ("prout")
Worksheets("JLL Complet").Range("A1:M41").CopyPicture
Worksheets("Feuil1").Paste
Dim Pict As Picture
Dim Nb As Byte
Application.ScreenUpdating = False
For Each Pict In Worksheets("Feuil1").Pictures
Pict.CopyPicture
Pict.Name = "JLL Complet"
With Worksheets("Feuil1").ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
.Paste
.Export ThisWorkbook.Path & "\" & Pict.Name & ".jpeg", "JPEG"
End With
Nb = Worksheets("Feuil1").ChartObjects.Count
Worksheets("Feuil1").ChartObjects(Nb).Delete
Next Pict
Application.ScreenUpdating = True
Worksheets("Feuil1").Pictures.Delete
Worksheets("JLL Complet").Protect ("prout")
End Sub
Avez-vous une idée pour me solutionner cela?
D'avance merci,
Bonne journée,
N.
afin d'afficher sur un téléviseur une cartographie créée dans excel, j'utilise une macro qui copie en image une feuille excel et qui la colle dans une nouvelle.
Mon problème est que dans cette macro, quand je viens coller la nouvelle image, elle se superpose aux autres déja présentes (du fait d'une précédente utilisation) sur cette même feuille et du coup au bout d'un certain temps la macro plante:
Sub ImagePlageCellules()
' JLL Complet
Worksheets("JLL Complet").Unprotect ("prout")
Worksheets("JLL Complet").Range("A1:M41").CopyPicture
Worksheets("Feuil1").Paste
Dim Pict As Picture
Dim Nb As Byte
Application.ScreenUpdating = False
For Each Pict In Worksheets("Feuil1").Pictures
Pict.CopyPicture
Pict.Name = "JLL Complet"
With Worksheets("Feuil1").ChartObjects.Add(0, 0, Pict.Width, Pict.Height).Chart
.Paste
.Export ThisWorkbook.Path & "\" & Pict.Name & ".jpeg", "JPEG"
End With
Nb = Worksheets("Feuil1").ChartObjects.Count
Worksheets("Feuil1").ChartObjects(Nb).Delete
Next Pict
Application.ScreenUpdating = True
Worksheets("Feuil1").Pictures.Delete
Worksheets("JLL Complet").Protect ("prout")
End Sub
Avez-vous une idée pour me solutionner cela?
D'avance merci,
Bonne journée,
N.