VBA : simplifier macro
algauthi
Messages postés
6
Statut
Membre
-
algauthi Messages postés 6 Statut Membre -
algauthi Messages postés 6 Statut Membre -
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!
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
Bonjour,
un exemple pour cette ligne:
C'est simple tu supprimes Select, ActiveSheet et Selection et mets ce qui suit
comme ceci:
Tu fais de même pour le reste
Voilà
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à
Malheureusement en appliquant ton exemple, mes images de se décolorent plus à l'activation de la macro..
Sheets("Formulaire").Shapes.Range(Array("Picture 5", "Picture 2", "Picture 3", _ "Picture 31", "Picture 7")).Glow.Radius = 0