Problème de création d'image

Ewigefrost

XLDnaute Junior
Bonjour à tous !

Bon je reviens pour un soucis sur mon projet d'enregistrement automatique de plages de cellules à chaque changement de cellules dans 2 des feuilles de mon classeur.

Voilà le code que j'utilise, il fait en sorte que dès qu'une cellule change dans TCD ALU ou TCD ACIER, une image d'un tableau+diagrammes (dans TCD ALU) à hauteur variable s'enregistre, et de même pour le tableau dans TCD ACIER. La date de l'enregistrement s'exporte aussi en image.

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)
    Sheets("Date").[B2] = Now
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
        Dim NLigneDescription As Long
        Dim Dligne As Long
    wshSheets = [{"TCD ACIER", "TCD ALU"}]
        
        If Not IsError(Application.Match(Sh.Name, wshSheets, 1)) Then
        
            With Worksheets("TCD ALU").Range("A1:N50")
                Cells.Find(What:="Total général", After:=Range("A1"), LookIn:=xlValues, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False).Activate
                NLigneDescription = ActiveCell.Row
                'Range("A200").Value = NLigneDescription
                Dligne = NLigneDescription + 14
                'Range("A201").Value = Dligne
                'Worksheets("TCD ALU").Range("N" & NLigneDescription & ":" & "W" & NLigneDescription).Interior.Color = RGB(222, 0, 0)
            End With
        
            With Worksheets("TCD ACIER").Range("P1:P40")
                Cells.Find(What:="Total général", After:=Range("P1"), LookIn:=xlValues, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False).Activate
                acier = ActiveCell.Row
                'Range("A200").Value = NLigneDescription
                dernieracier = acier + 7
                'Range("A201").Value = Dligne
                'Worksheets("TCD ALU").Range("N" & NLigneDescription & ":" & "W" & NLigneDescription).Interior.Color = RGB(222, 0, 0)
            End With
        
            With Sheets("date")
                .Range("B2").CopyPicture xlScreen, xlPicture
                    With .ChartObjects.Add(0, 0, .Range("B2").Width, .Range("B2").Height).Chart
                        .Paste
                        .Export ThisWorkbook.Path & "\date.png", "PNG"
                    End With
                .ChartObjects(Sheets("date").ChartObjects.Count).Delete
            End With
            
            With Sheets("TCD ACIER")
                Worksheets("TCD ACIER").Activate
                ActiveWindow.Zoom = 100
                .Range("P2:AA" & dernieracier).CopyPicture xlScreen, xlBitmap
                    With .ChartObjects.Add(0, 0, 2400, 1429).Chart
                        .Paste
                        .Export ThisWorkbook.Path & "\test2.gif", "gif"
                    End With
                '.ChartObjects(Sheets("TCD ACIER").ChartObjects.Count).Delete
            End With

            With Sheets("TCD ALU")
                Worksheets("TCD ALU").Activate
                ActiveWindow.Zoom = 120
                .Range("N2:X" & Dligne).CopyPicture xlScreen, xlBitmap
                    With .ChartObjects.Add(0, 0, 2400, 1429).Chart
                        .Paste
                        .Export ThisWorkbook.Path & "\test1.gif", "gif"
                    End With
                '.ChartObjects(Sheets("TCD ALU").ChartObjects.Count).Delete
            End With
            
            ActiveWorkbook.Save
        End If
End Sub

Les variables "dernieracier" et "Dligne" sont les variables qui me permettent de trouver la ligne de fin du tableau+diagrammes (dont le nombre de lignes est variable je rappelle).

Le macro fonctionne, elle ne plante pas, mais il y a deux problèmes :
-lorsque j'ajoute une ligne dans TCD ALU, l'image exportée de TCD ALU est bonne, alors que celle de TCD ACIER bug complètement (et vice-versa)
-de plus, sur les images qui s'exportent, il y a les diagrammes en fond mais avec une mise en forme totalement différente et inadaptée (déjà ils ne devraient pas apparaitre en plus des diagrammes "normaux", et ensuite ils se mettent en fond, c'est très bizarre). J'ai l'impression que des lignes dans la macro disent implicitement à Excel de recréer des diagrammes, mais ça ne me convient absolument pas !

J'espère que j'ai été assez clair, je suis preneur de toutes explications !

Merci beaucoup par avance !

PS : l'exportation marche très bien lorsque je spécifie un range fixe dans ces lignes :
Code:
With Sheets("TCD ALU")
                Worksheets("TCD ALU").Activate
                ActiveWindow.Zoom = 120
                .Range("N2:X" & Dligne).CopyPicture xlScreen, xlBitmap
                    With .ChartObjects.Add(0, 0, 2400, 1429).Chart
                        .Paste
                        .Export ThisWorkbook.Path & "\test1.gif", "gif"
                    End With
                '.ChartObjects(Sheets("TCD ALU").ChartObjects.Count).Delete
            End With
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 206
Messages
2 086 221
Membres
103 158
dernier inscrit
laufin