automatiser une procédure qui se répète sur plusieurs feuilles

[juju44]

Bonjour à tous,

je fais appel à votre aide pour résoudre le problème suivant :

Dans mon classeur j'ai plusieurs feuilles de calcul nommées chantier1, chantier2, chantier3,...Sur ces feuilles, j'ai nommé des cellules ou des plages de cellules. Ex : DTouTous_C1, DTouTous_C2, DTouTous_C3........COD_DT_C1, COD_DT_C2, COD_DT_C3,....

Voici la procédure & laquelle je fais appel pour ma feuille "Chantier1"

Sub AfficDT0_C1_QuandClic()
    'Bouton permettant d'afficher alternativement que DT ou tous les sites de la DT
    
    Application.ScreenUpdating = False
    
    Application.Calculation = xlManual
    'Bloquage du calcul auto
      
    ActiveSheet.Rows("16:800").Hidden = True
    
    If [DTouTous_C1] = "Afficher seulement les résultats de la DT" Then
        With ActiveSheet
            With .range("A16:A800").Offset(, .Columns.Count - 1)
                .FormulaR1C1 = "=IF(or(RC1=COD_DT_C1, and(len(RC1)=3, left(RC1,2)=DT), RC1=""ok""),""x"",0)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Hidden = False
                On Error GoTo 0
                .Clear
            End With
        End With

        [DTouTous_C1] = "Afficher tous les sites de la DT"

    Else
        [DTouTous_C1] = "Afficher seulement les résultats de la DT"
    
        With ActiveSheet
            With .range("A16:A800").Offset(, .Columns.Count - 1)
                .FormulaR1C1 = "=IF(or(left(RC3,2)=DT,RC1=""ok""),""x"",0)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Hidden = False
                On Error GoTo 0
                .Clear
            End With
        End With

    End If
    
[List_sites].Text = ""

Application.ScreenUpdating = True

End Sub

et celle utilisée pour la feuille Chantier3

Sub AfficDT0_C3_QuandClic()
    'Bouton permettant d'afficher alternativement que DT ou tous les sites de la DT
    
    Application.ScreenUpdating = False
    
    Application.Calculation = xlManual
    'Bloquage du calcul auto
      
    ActiveSheet.Rows("16:800").Hidden = True
    
    If [DTouTous_C3] = "Afficher seulement les résultats de la DT" Then
        With ActiveSheet
            With .range("A16:A800").Offset(, .Columns.Count - 1)
                .FormulaR1C1 = "=IF(or(RC1=COD_DT_C3, and(len(RC1)=3, left(RC1,2)=DT), RC1=""ok""),""x"",0)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Hidden = False
                On Error GoTo 0
                .Clear
            End With
        End With

        [DTouTous_C3] = "Afficher tous les sites de la DT"

    Else
        [DTouTous_C3] = "Afficher seulement les résultats de la DT"
    
        With ActiveSheet
            With .range("A16:A800").Offset(, .Columns.Count - 1)
                .FormulaR1C1 = "=IF(or(left(RC3,2)=DT,RC1=""ok""),""x"",0)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Hidden = False
                On Error GoTo 0
                .Clear
            End With
        End With

    End If
    
[List_sites].Text = ""

Application.ScreenUpdating = True

End Sub

Seuls changement entre ces 2 procédures, les références aux plages nommées

Ma question : comment rédiger une unique procédure que je mettrai dans un module pour éviter d'avoir à l'écrire dans chacune des feuilles "chantier" et ainsi optimiser le code.

Merci d'avance de me donner quelques pistes !

Bonne journée

 

[juju44]

Re : automatiser une procédure qui se répète sur plusieurs feuilles

bon c'était tout bête finalement...

Sub AfficDT(A As range, B As range)
    'Bouton permettant d'afficher alternativement que DT ou tous les sites de la DT
    
    Application.ScreenUpdating = False
    
    Application.Calculation = xlManual
    'Bloquage du calcul auto
    
    ActiveSheet.Rows("16:800").Hidden = True
    
    If A = "Afficher seulement les résultats de la DT" Then
        With ActiveSheet
            With .range("A16:A800").Offset(, .Columns.Count - 1)
                .FormulaR1C1 = "=IF(or(RC1=" & B & ", and(len(RC1)=3, left(RC1,2)=DT), RC1=""ok""),""x"",0)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Hidden = False
                On Error GoTo 0
                .Clear
            End With
        End With

        A = "Afficher tous les sites de la DT"

    Else
        A = "Afficher seulement les résultats de la DT"
    
        With ActiveSheet
            With .range("A16:A800").Offset(, .Columns.Count - 1)
                .FormulaR1C1 = "=IF(or(left(RC3,2)=DT,RC1=""ok""),""x"",0)"
                On Error Resume Next
                .SpecialCells(xlCellTypeFormulas, xlTextValues).EntireRow.Hidden = False
                On Error GoTo 0
                .Clear
            End With
        End With

    End If
    
[List_sites].Text = ""

Application.ScreenUpdating = True

End Sub