lancer des macros à la sélection de feuilles

**AstridT** · 24/05/2011, 15h26

Bonjour,

Je cherche à lancer une macro lorsque d'une feuille X je sélectionne ma feuille Y.
J'ai vu pas mal de choses déjà sur différents forum à ce sujet mais je n'arrive pas à les faire fonctionner (Worksheet_Activate(), Worksheet_SelectionChange(), Call Module1.MaMacro, etc etc)

Des idées de pourquoi ça ne marche pas ?
Merci d'avance !

**mercatog** · 24/05/2011, 15h49

Worksheet_Activate() fera l'affaire (dans le module de ta feuille) ou bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

dans le module Thisworkbook avec Sh la feuille activée.

**bellande** · 24/05/2011, 15h49

bonjour,
peux tu en dire plus sur ton besoin et ce qui ne fonctionne pas actuellement.
Veux tu le même traitement si tu passes de X à Y ou si tu passes de Z à Y ?
L'évènement activate peut fonctionner de manière inconditionnelle ou non.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub Worksheet_Activate()
  MsgBox "feuil1"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
Private Sub Worksheet_Activate()
  MsgBox "feuil2"
End Sub

**AstridT** · 24/05/2011, 16h00

Bonjour,

Merci pour vos réponses. J'ai déjà essayé toutes les méthodes dont vous parlez et aucune ne me lance mes macros.
Si depuis Visual Basic j'exécute

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Worksheet_Activate()
  MsgBox "feuil1"
End Sub

(ou les autres d'ailleurs) alors pour le coup ça marche .
Par contre, dans mon classeur, si je passe de n'importe quelle feuille à la feuille sur laquelle je voudrai que ma macro se déclenche, rien ne se passe....

Peut être manque t'il une option quelque part ?
Pour l'instant je déclenche mes macros par bouton sur chacune de mes feuilles (ça marche sans soucis) mais l'idéal serait vraiment que les calculs s'exécutent tout seul à l'arrivée sur la feuille.

**mercatog** · 24/05/2011, 16h05

1. Lance cette macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub Test()
 
Application.EnableEvents = True
End Sub

Le 1. est nécessaire au cas où les évènements sont désactivés

2. Dans le module Thisworkbook, mets ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
 
MsgBox Sh.Name
End Sub

Active tes feuilles successivement

**bellande** · 24/05/2011, 16h09

Tu n'aurais pas appuyé sur l'icone de l'équerre bleu ciel "mode création" dans la barre d'outils ?
(Dans ce cas les macros ne peuvent se lancer que par l'éditeur)
Dans ce cas, il faut recliquer dessus

**AstridT** · 24/05/2011, 16h23

L'icône création n'est pas cochée et toutes mes macros commencent par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With Application
.ScreenUpdating = False
.EnableEvents = True
End With

J'ai essayé ce que tu dis mercatog mais sans succès.

**mercatog** · 24/05/2011, 16h26

Mets donc un extrait de ton fichier avec le code pour voir en PJ.

**jijie** · 24/05/2011, 16h36

Envoyé par AstridT

Bonjour,

Je cherche à lancer une macro lorsque d'une feuille X je sélectionne ma feuille Y.

Je ne comprends pas la question! Perso je ne suis pas un bête mais de lancer une macro d'une feuille x ( par quel moyen ? ) pour sélectionner une feuille Y ce n'est pas difficile!! Il faut peut-être que tu renseigne l'adresse de la feuille X du style feuilleactive = activesheet.name !!

Donne + de renseignement sur ta macro!

**AstridT** · 24/05/2011, 16h53

Bon et bien je me sens un peu nulle là quand même mais surtout je ne comprend toujours pas......

J'étais en train de préparer un classeur exemple de mon travail, j'en ai donc fait une copie pure et simple et j'étais en train de l'alléger en code et informations confidentielles. J'avais toujours des macros là où il y en avait, "presque" pareil quoi

Je teste, ça marche les macros s'exécutent à la sélection des feuilles !

Je retourne sur mon classeur original que je n'ai en rien modifié.... il marche aussi !

(sauf une des macros qui tout d'un coup tourne en rond mais bon...)

Donc je ne comprend pas mais merci pour l'aide, d'une façon ou d'une autre vous l'avez fait fonctionner

Désolée pour le dérangement surtout !!

Juste une petite dernière question :

Pourquoi une macro qui tourne très bien quand lancée depuis VB, ou par click sur un bouton dans ma feuille, ou par raccourcis clavier depuis ma feuille, déciderait soudain de tourner "en rond" quand lancée depuis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Worksheet_Activate()
 Call Module2.Ecuries
End Sub

?

Et quand je dis tourne en rond.... dans mon classeur, j'ai le curseur d'attente. Si j'appuie sur Echap je coupe l'exécution de la macro et à chaque fois l'endroit du code surligné est différent et pourtant toutes les infos demandées à la macro apparaissent sur ma feuille comme si l'exécution était terminée.....???

**mercatog** · 24/05/2011, 17h31

Mets ici le code de la procédure
Ecuries.

**AstridT** · 24/05/2011, 17h45

Voici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
Sub Ecuries()
 
With Application
        .ScreenUpdating = False
        .EnableEvents = True
End With
 
With Worksheets("Ecurie")
 
Dim Pvt As PivotTable
Dim i As Integer, j As Integer
Dim car As Variant
 
    i = 5
 
    'Supprime les données déjà dans le tableau
    .Range("A5", .Range("G5").End(xlDown)).Select
    Selection.ClearContents
    .Range("B2:G2").Select
    Selection.ClearContents
    .Range("A1").Select
 
    Worksheets("Stats").Select
 
    Set Pvt = Worksheets("Stats").PivotTables("Tableau croisé dynamique1")
 
    'Récupère le meilleur temps, la moyenne, le nombre de tours significatifs et l'écart type pour chaque voiture
    For Each car In Pvt.PivotFields("Voiture").PivotItems
        On Error Resume Next
        .Select
        .Cells(i, 1).Value = car
        .Cells(i, 1).Offset(, 3).Value = Pvt.GetData("'Voiture' " & car & " 'Min'")
        .Cells(i, 1).Offset(, 4).Value = Pvt.GetData("'Voiture' " & car & " 'Moyenne'")
        .Cells(i, 1).Offset(, 5).Value = Pvt.GetData("'Voiture' " & car & " 'Nombre'")
        .Cells(i, 1).Offset(, 6).Value = Pvt.GetData("'Voiture' " & car & " 'Ecart type'")
        i = i + 1
    Next
 
    'Supprime les lignes des voitures sans données (ne participant pas à l'évènement)
    Dim fin As Long
    fin = .Cells(.Rows.Count, "A").End(xlUp).Row
    On Error Resume Next
    .Range("D5:D" & fin).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
 
    i = 1
 
    'Récupère le nom de l'écurie et la catégorie de la voiture en fonction de son numéro
    For Each cell In .Range("A5", .Range("A5").End(xlDown))
        For Each car In Worksheets("listes").Range("A1", Worksheets("listes").Range("A1").End(xlDown))
            If CStr(car) = cell Then
                cell.Offset(, 1).Value = Worksheets("listes").Cells(i, 2).Value
                cell.Offset(, 2).Value = Worksheets("listes").Cells(i, 3).Value
                Exit For
            End If
            i = i + 1
        Next
        i = 1
    Next
 
    i = 5
 
    'Mise en forme (chiffres significatif, tableau, etc)
    .Range(.Cells(i, 4), .Cells(i, 4).End(xlDown)).Select
    Selection.NumberFormat = "0.000"
    .Range(.Cells(i, 5), .Cells(i, 5).End(xlDown)).Select
    Selection.NumberFormat = "0.0"
    .Range(.Cells(i, 6), .Cells(i, 6).End(xlDown)).Select
    Selection.NumberFormat = "0"
    .Range(.Cells(i, 7), .Cells(i, 7).End(xlDown)).Select
    Selection.NumberFormat = "0.0"
    .Range(.Cells(i, 1), .Cells(i, 7).End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
 
 
    'Calcul du meilleur temps général et de la meilleure moyenne
    Set best = .Range("D5", .Range("D5").End(xlDown))
    Set moy = .Range("E5", .Range("E5").End(xlDown))
    .Range("I1").FormulaArray = "=MIN('Ecurie'!" & best.Address & ")"
    .Range("I2").FormulaArray = "=MIN('Ecurie'!" & moy.Address & ")"
 
    'Calcul des moyennes par classe (en commentaire car non fonctionnel pour l'instant)
    'Set class = .Range("C5", .Range("C5").End(xlDown))
    'Set car = .Range("A5", .Range("A5").End(xlDown))
    '.Range("B2").FormulaArray = _
        "=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("C5").Value & ")*('Ecurie'!" & car.Address & " < 11),'Ecurie'!" & moy.Address & "))"
    '.Range("C2").FormulaArray = _
        "=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("C5").Value & ")*('Ecurie'!" & car.Address & "> 10),'Ecurie'!" & moy.Address & "))"
    '.Range("D2").FormulaArray = _
        "=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("D1").Value & ")*('Ecurie'!" & car.Address & "< 50),'Ecurie'!" & moy.Address & "))"
    '.Range("E2").FormulaArray = _
        "=AVERAGE(IF(('Ecurie'!" & class.Address & "= GT1),'Ecurie'!" & moy.Address & "))"
    '.Range("F2").FormulaArray = _
        "=AVERAGE(IF(('Ecurie'!" & class.Address & "= GT2),'Ecurie'!" & moy.Address & "))"
    '.Range("G2").FormulaArray = _
        "=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("D1").Value & ")*('Ecurie'!" & car.Address & "> 50),'Ecurie'!" & moy.Address & "))"
 
 
    'Identification par fond jaune des meilleurs résultats dans le tableau
    For Each tps In .Range("D5", .Range("D5").End(xlDown))
        If tps.Value = .Range("I1").Value Then
            tps.Interior.Color = RGB(250, 250, 0)
        Else
            tps.Interior.ColorIndex = xlNone
        End If
    Next
 
    For Each tps In .Range("E5", .Range("E5").End(xlDown))
        If tps.Value = .Range("I2").Value Then
            tps.Interior.Color = RGB(250, 250, 0)
        Else
            tps.Interior.ColorIndex = xlNone
        End If
    Next
 
    'Suppresssion des cellules de calculs temporaires
    .Range("I1:I2").Select
    Selection.Clear
 
    .Range("A1").Select
 
End With
End Sub

**mercatog** · 24/05/2011, 17h55

Evite les Select (des feuilles et des ranges)
Déclare toutes tes variables
Pour un début

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub Ecuries()
Dim Pvt As PivotTable
Dim i As Integer, j As Integer
Dim Fin As Long
Dim Car As Variant
Dim c As Range, Best As Range, Moy As Range
 
Application.ScreenUpdating = False
With Worksheets("Ecurie")
'Supprime les données déjà dans le tableau
    .Range("A5", .Range("G5").End(xlDown)).ClearContents
    .Range("B2:G2").ClearContents
    Set Pvt = Worksheets("Stats").PivotTables("Tableau croisé dynamique1")
'Récupère le meilleur temps, la moyenne, le nombre de tours significatifs et l'écart type pour chaque voiture
    i = 5
    For Each Car In Pvt.PivotFields("Voiture").PivotItems
        On Error Resume Next
        .Cells(i, 1).Value = Car
        .Cells(i, 1).Offset(, 3).Value = Pvt.GetData("'Voiture' " & Car & " 'Min'")
        .Cells(i, 1).Offset(, 4).Value = Pvt.GetData("'Voiture' " & Car & " 'Moyenne'")
        .Cells(i, 1).Offset(, 5).Value = Pvt.GetData("'Voiture' " & Car & " 'Nombre'")
        .Cells(i, 1).Offset(, 6).Value = Pvt.GetData("'Voiture' " & Car & " 'Ecart type'")
        i = i + 1
    Next Car
'Supprime les lignes des voitures sans données (ne participant pas à l'évènement)
    Fin = .Cells(.Rows.Count, "A").End(xlUp).Row
    On Error Resume Next
    .Range("D5:D" & Fin).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
'Récupère le nom de l'écurie et la catégorie de la voiture en fonction de son numéro
    For Each c In .Range("A5", .Range("A5").End(xlDown))
        i = 1
        For Each Car In Worksheets("listes").Range("A1", Worksheets("listes").Range("A1").End(xlDown))
            If CStr(Car) = c Then
                c.Offset(, 1).Value = Worksheets("listes").Cells(i, 2).Value
                c.Offset(, 2).Value = Worksheets("listes").Cells(i, 3).Value
                Exit For
            End If
            i = i + 1
        Next Car
    Next c
 
    i = 5
'Mise en forme (chiffres significatif, tableau, etc)
    .Range(.Cells(i, 4), .Cells(i, 4).End(xlDown)).NumberFormat = "0.000"
    .Range(.Cells(i, 5), .Cells(i, 5).End(xlDown)).NumberFormat = "0.0"
    .Range(.Cells(i, 6), .Cells(i, 6).End(xlDown)).NumberFormat = "0"
    .Range(.Cells(i, 7), .Cells(i, 7).End(xlDown)).NumberFormat = "0.0"
    With .Range(.Cells(i, 1), .Cells(i, 7).End(xlDown))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
 
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
 
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With
'Calcul du meilleur temps général et de la meilleure moyenne
    Set Best = .Range("D5", .Range("D5").End(xlDown))
    Set Moy = .Range("E5", .Range("E5").End(xlDown))
    .Range("I1").FormulaArray = "=MIN('Ecurie'!" & Best.Address & ")"
    .Range("I2").FormulaArray = "=MIN('Ecurie'!" & Moy.Address & ")"
'...etc

**AstridT** · 24/05/2011, 18h09

En effet ça ne plante plus !
Merci beaucoup !

Quel était le problème finalement ? mon manque de rigueur et trop de choses telles que les select qui prenaient trop de mémoire ou quelque chose comme ça ?

Sais tu pourquoi ça passait sans soucis par click sur un bouton/raccourcis clavier ?

**mercatog** · 24/05/2011, 19h29

L'évènement Activate lance la macro Ecuries, qui elle même Active les feuilles, cette 2ème activation relance la macro...etc et indéfiniment.

Pour éviter cette avalanche infinie, soit tu mets au début de la macro Ecuries

Code :

Sélectionner tout - Visualiser dans une fenêtre à part