VBA : simplifier macro

algauthi Messages postés 6 Date d'inscription   Statut Membre Dernière intervention   -  
algauthi Messages postés 6 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous,

Vous trouverez ci-dessous ma dernière macro qui me sert à effacer les données d'un document Excel.
L'objectif : m'aider à la simplifier, car je sais que j'ai beaucoup de .Select.

Merci d'avance pour votre aide!

Sub efface()

'Macro qui efface les données de la matrice

'En cas d'erreur d'exécution, la macro doit se poursuivre
On Error Resume Next

'Fige l'écran
Application.ScreenUpdating = False

'Efface Formulaire et décolore les pictogrammes
Sheets("Formulaire").Select
ActiveSheet.Shapes.Range(Array("Picture 5", "Picture 2", "Picture 3", _
        "Picture 31", "Picture 7")).Select
Selection.ShapeRange.Glow.Radius = 0

'Barre de progression
Dim i As Long
For i = 0 To 3
    BarreDeSuppression.BarreVal i, 20
    
Next

Range("A2,B3,B5,B19").Select
Selection.ClearContents
Range("B28:F28").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("N6,N7").Select
Selection.ClearContents

'Barre de progression
For i = 4 To 6
    BarreDeSuppression.BarreVal i, 20

Next

'Efface Formulaire 2
Sheets("Formulaire (2)").Activate
Range("A9,A33,A49").Select
Selection.ClearContents
Range("A25:A27").Select
Selection.ClearContents

'Barre de progression
For i = 7 To 10
    BarreDeSuppression.BarreVal i, 20

Next

'Efface Compilemail Valeurs
Sheets("Compilemail Valeurs").Activate
Range("A2:C2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents

'Barre de progression
For i = 11 To 14
    BarreDeSuppression.BarreVal i, 20
    
Next
    
'Efface la synthèse des contacts
Sheets("Synthèse des contacts").Activate
Range("A9:F9").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


'Barre de progression
For i = 15 To 18
    BarreDeSuppression.BarreVal i, 20
    
Next

'Rends invisible le bouton macro RestitutionContacts
Sheets("Formulaire").Activate
ActiveSheets.Shapes.Range(Array("Rectangle 24")).Select
Selection.ShapeRange.ZOrder msoBringToFront

'Barre de progression
For i = 19 To 20
    BarreDeSuppression.BarreVal i, 20
    
Next

'Enlèvre la barre de progression
Unload BarreDeSuppression

'Défige l'écran
Application.ScreenUpdating = True
Range("B3").Select

End Sub

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

1 réponse

cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Bonjour,

un exemple pour cette ligne:

Sheets("Formulaire").Select
ActiveSheet.Shapes.Range(Array("Picture 5", "Picture 2", "Picture 3", _
        "Picture 31", "Picture 7")).Select
Selection.ShapeRange.Glow.Radius = 0


C'est simple tu supprimes Select, ActiveSheet et Selection et mets ce qui suit

comme ceci:


Sheets("Formulaire").Shapes.Range(Array("Picture 5", "Picture 2", "Picture 3", _
        "Picture 31", "Picture 7")).ShapeRange.Glow.Radius = 0


Tu fais de même pour le reste

Voilà

0
algauthi Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Le Pivert,

Malheureusement en appliquant ton exemple, mes images de se décolorent plus à l'activation de la macro..
0
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
et comme ceci:

Sheets("Formulaire").Shapes.Range(Array("Picture 5", "Picture 2", "Picture 3", _
        "Picture 31", "Picture 7")).Glow.Radius = 0
0
algauthi Messages postés 6 Date d'inscription   Statut Membre Dernière intervention  
 
Super ça fonctionne merci beaucoup pour le coup de main, ne reste qu'à l'appliquer partout!
0