Workbook_Sheetchange à appliquer à seulement 2 feuilles

[Ewigefrost]

Bonjour à tous,

J'ai une macro qui fonctionne plutôt bien et qui me permet d'enregistrer des plages de cellules sous forme d'image dès qu'il y a un changement dans une feuille de mon classeur.

Cependant, j'aimerais faire en sorte que ma macro ne s'exécute que lorsqu'il y a un changement sur les feuilles "TCD ALU" et "TCD ACIER".

Voilà mon code (je peux l'expliquer si nécessaire) :

'Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

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 alu As Long
        Dim dernieralu As Long
        Dim acier As Long
        Dim dernieracier As Long
        wshSheets = [{"TCD ACIER, TCD ALU"}]
        
        If Not IsError(Application.Match(Sh.Name, wshSheets, 1)) Then
        
            'ActiveWorkbook.RefreshAll
        
            'Sleep 30000
            
            With Worksheets("TCD ALU").Range("A1:N50")
                Worksheets("TCD ALU").Activate
                Cells.Find(What:="Total général", After:=Range("A1"), LookIn:=xlValues, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False).Activate
                alu = ActiveCell.Row
                'Range("A200").Value = alu
                dernieralu = alu + 14
                'MsgBox alu
                'Range("A201").Value = dernieralu
                'Worksheets("TCD ALU").Range("N" & alu & ":" & "W" & alu).Interior.Color = RGB(222, 0, 0)
            End With
        
            With Worksheets("TCD ACIER").Range("P1:P40")
                Worksheets("TCD ACIER").Activate
                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 = alu
                dernieracier = acier + 7
                'MsgBox acier
                'Range("A201").Value = dernieralu
                'Worksheets("TCD ALU").Range("N" & alu & ":" & "W" & alu).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
                hauteurligneacier = 1500 / dernieracier
                Rows(2 & ":" & dernieracier).RowHeight = hauteurligneacier
                .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
                hauteurlignealu = 1500 / dernieralu
                Rows(2 & ":" & dernieralu).RowHeight = hauteurlignealu
                .Range("N2:X" & dernieralu).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

Je pensais que cette ligne

wshSheets = [{"TCD ACIER, TCD ALU"}]

permettait de résoudre mon problème, mais finalement je ne comprends pas son utilité.

Existerait-il un code qui me permette de remplacer le "Workbook" par "Worksheet("TCD ALU", "TCD ACIER") ou quelque chose comme ça dans cette ligne :

Private Sub Workbook_BeforeSave(ByVal SaveAsUi As Boolean, Cancel As Boolean)

J'ai pensé à placer cette macro dans des modules des pages sélectionnées, mais cela supprimerait le caractère automatique de la macro, et c'est hors de question.

Sauriez-vous comment je pourrais m'y prendre svp ?

Merci par avance, bonne après-midi !

 

[Pierrot93]

Re : Workbook_Sheetchange à appliquer à seulement 2 feuilles

Bonjour,

peut être en testant ainsi :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not Sh.Name Like "TCD ALU" And Not Sh.Name Like "TCD ACIER" Then Exit Sub

bon après midi
@+

 

[Ewigefrost]

Re : Workbook_Sheetchange à appliquer à seulement 2 feuilles

Merci énormément pour cette réponse rapide, ça marche nickel !

Ca doit faire le cinquième problème que je résouds grâce à vous, gens du forum ! Merci infiniment ! ;D