XL 2016 macro trop longue

christ77000 · 22 Juillet 2020

Bonsoir, j'ai une macro qui modifie la couleur de mes boutons. serait 'il possible te la faire plus courte.

raccourcir toutes ces lignes : ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 46")).Select je fais la même chose pour du vert du jaune et du gris donc le nombre de ligne est très important.

Merci pour votre aide.

VB:

Sub theme_bouton_bleu()
'
' Macro1 Macro
'
Application.ScreenUpdating = False '---cacher les actions de la macro---
'Sheets("Menu").Select
Call Retirer_la_protection
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 46")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 37")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 38")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 39")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 40")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 35")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
Call Protéger_la_feuille
Sheets("Réglages").Select
'Application.ScreenUpdating = False '---cacher les actions de la macro---
Call Retirer_la_protection
Call Voir_colonne_réglages
Rows("23:28").Select
Selection.EntireRow.Hidden = False
ActiveSheet.Shapes("Organigramme : Alternative 41").Visible = True
    
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 22")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 39")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 40")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 41")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 38")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 26")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 27")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 28")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 29")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 30")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 31")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 32")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 35")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 33")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 34")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 36")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.6000000238
    End With
        ActiveSheet.Shapes("Organigramme : Alternative 41").Visible = False
    Rows("23:28").Select
    Selection.EntireRow.Hidden = True
    Cacher_colonne_réglages
    Call Protéger_la_feuille
    Application.ScreenUpdating = True '---voir les actions de la macro---
    Sheets("Menu").Select
    
    
End Sub

christ77000 · 23 Juillet 2020

j'ai trouvé un peut plus court mais bon pas top

VB:

Sub theme_bouton_bleu()
'
' Macro1 Macro
'
Application.ScreenUpdating = False '---cacher les actions de la macro---
'Sheets("Menu").Select
Call Retirer_la_protection
    ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 46", "Flowchart: Alternate Process 37", _
    "Flowchart: Alternate Process 38", "Flowchart: Alternate Process 39", "Flowchart: Alternate Process 40", _
    "Flowchart: Alternate Process 35")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.400000006
    End With
    
Call Protéger_la_feuille
Sheets("Réglages").Select
'Application.ScreenUpdating = False '---cacher les actions de la macro---
Call Retirer_la_protection
Call Voir_colonne_réglages
Rows("23:28").Select
Selection.EntireRow.Hidden = False
ActiveSheet.Shapes("Organigramme : Alternative 41").Visible = True
    
ActiveSheet.Shapes.Range(Array("Flowchart: Alternate Process 22", "Flowchart: Alternate Process 39", _
"Flowchart: Alternate Process 40", "Flowchart: Alternate Process 41", "Flowchart: Alternate Process 38", _
"Flowchart: Alternate Process 26", "Flowchart: Alternate Process 27", "Flowchart: Alternate Process 28", _
"Flowchart: Alternate Process 29", "Flowchart: Alternate Process 30", "Flowchart: Alternate Process 31", _
"Flowchart: Alternate Process 32", "Flowchart: Alternate Process 35", "Flowchart: Alternate Process 33", _
"Flowchart: Alternate Process 34", "Flowchart: Alternate Process 36")).Select
    With Selection.ShapeRange.Fill
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.Brightness = 0.400000006
    End With
            ActiveSheet.Shapes("Organigramme : Alternative 41").Visible = False
    Rows("23:28").Select
    Selection.EntireRow.Hidden = True
    Cacher_colonne_réglages
    Call Protéger_la_feuille
    Application.ScreenUpdating = True '---voir les actions de la macro---
    Sheets("Menu").Select
    
    
End Sub

XL 2016 macro trop longue

christ77000

XLDnaute Occasionnel

christ77000

XLDnaute Occasionnel

Discussions similaires