lancer des macros à la sélection de feuilles

Version imprimable

24/05/2011, 14h26
AstridT

lancer des macros à la sélection de feuilles

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 !
24/05/2011, 14h49
mercatog

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

Code:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

dans le module Thisworkbook avec Sh la feuille activée.
24/05/2011, 14h49
bellande

activate
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:

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

1 2 3 4 5 Private Sub Worksheet_Activate() MsgBox "feuil2" End Sub
24/05/2011, 15h00
AstridT
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:

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.
24/05/2011, 15h05
mercatog
1. Lance cette macro
Code:

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:

1 2 3 4 Private Sub Workbook_SheetActivate(ByVal Sh As Object) MsgBox Sh.Name End Sub
Active tes feuilles successivement
24/05/2011, 15h09
bellande

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
24/05/2011, 15h23
AstridT
L'icône création n'est pas cochée et toutes mes macros commencent par
Code:

1 2 3 4 With Application .ScreenUpdating = False .EnableEvents = True End With
J'ai essayé ce que tu dis mercatog mais sans succès.
24/05/2011, 15h26
mercatog

Mets donc un extrait de ton fichier avec le code pour voir en PJ.
24/05/2011, 15h36
jijie

Citation:

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!
24/05/2011, 15h53
AstridT
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 ! 8O
Je retourne sur mon classeur original que je n'ai en rien modifié.... il marche aussi ! 8O8O
(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:

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.....???
24/05/2011, 16h31
mercatog

Mets ici le code de la procédure
Ecuries.

Voici :

Code:

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

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

Code:

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

24/05/2011, 17h09
AstridT

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 ?
24/05/2011, 18h29
mercatog

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:

Application.enableevents=false

et à la fin

Code:

Application.enableevents=true

Soit éviter carrément les Select et Activate qui ne font que ralentir le code et le rendre instable comme tu l'as constaté.