Executer une macro sur une feuille

Version imprimable

25/07/2009, 02h00
FCL31

Executer une macro sur une feuille

:salut:

Lors de l'ouverture d'un fichier Excel, j'ai une macro qui regrouppe les données de deux autre fichiers Excel sur deux feuilles différentes (une par fichier importé)

A la fin de l'execution de cette macro, je voudrais lancer une autre macro sur une des deux fuilles.

Je sais pas comment faire pour que ma seconde macro soit affilié à simplement une des deux feuilles

HELP !!

Merci
25/07/2009, 10h14
ouskel'n'or

Déjà, (s'il s'agit bien de l'écriture d'une macro par macro dans la feuille de code d'une feuille de calculs, vue par le passé) depuis le code d'une feuille de calculs tu ne peux lancer qu'une macro placée dans un module standard.
"Sur l'autre feuille" n'est pas un problème si tu connais le nom de cette "autre feuillle" Il te suffit de la nommer dans ton code.
Bonne journée

NB - Pas de Help dans tes messages ;)

PS - Ton avatar est affreux ! Pour le modifier tu vas dans "Messages personnels :rire: :mouarf: :aie:

Voici la macro que je veu qui s'applique a une feuille

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
Sub MiseEnForme()
'
' supprimer lignes négatives Macro
' Macro enregistrée le 06/07/2009 par st22296
'
' Touche de raccourci du clavier: Ctrl+k
'
 
'****** effacer couleur jaunasse
Range("A2:K1000").Select
Selection.Interior.ColorIndex = xlNone
'******
Dim LigneTrackNegatif As Long
LigneTrackNegatif = 2
Do While LigneTrackNegatif <= 1000 And Cells(LigneTrackNegatif, 15).Value <> ""
    If Cells(LigneTrackNegatif, 15).Value < 0 Then
        Rows(LigneTrackNegatif).Delete
    End If
LigneTrackNegatif = LigneTrackNegatif + 1
Loop
'************** effacer colonnes inutiles
Range("A:A,B:B,M:M,O:O").Select
Selection.Delete
 
'*************effacer les lignes sans OF
Dim LigneTrackPasOF As Long
LigneTrackPasOF = 2
Do While LigneTrackPasOF <= 1000
    If Cells(LigneTrackPasOF, "A").Value = "" Then
        Rows(LigneTrackPasOF).Delete
    End If
LigneTrackPasOF = LigneTrackPasOF + 1
Loop
'*************************
'********** insérer colonne commentaire et priorité
'Range("M1").Select
'ActiveCell.FormulaR1C1 = "priorité"
'Range("N1").Select
'ActiveCell.FormulaR1C1 = "commentaire"
Range("M1").FormulaR1C1 = "Commentaire"
Range("M1").Value = "Commentaire"
Range("N1").FormulaR1C1 = "Priorité"
Range("N1").Value = "Priorité"
'*************************
'********** insérer dans colonne commentaire "Sans délais"
' si date prévue = VIDE ou =31/12/9999
Dim LigneTrackSansDelais As Long
LigneTrackSansDelais = 2
Do While LigneTrackSansDelais <= 1000
    If Cells(LigneTrackSansDelais, "L").Value = "" Or Cells(LigneTrackSansDelais, "L").Value = "31/12/9999" Then
        Cells(LigneTrackSansDelais, "M").Value = "Sans Délais"
    End If
LigneTrackSansDelais = LigneTrackSansDelais + 1
Loop
'*************************
'********** insérer dans colonne commentaire "Délais dépassé"
' si date prévue <= date du jour
Dim LigneTrackDelaisDepasse As Long
Dim MyDate
LigneTrackDelaisDepasse = 2
Do While LigneTrackDelaisDepasse <= 1000
    'MyDate = Cells(LigneTrackDelaisDepasse, 12).DateValue
    If Cells(LigneTrackDelaisDepasse, 12) <= Date And Cells(LigneTrackDelaisDepasse, 12) <> "" Then
        Cells(LigneTrackDelaisDepasse, 13).Value = "Délais dépassé"
    End If
LigneTrackDelaisDepasse = LigneTrackDelaisDepasse + 1
Loop
'*************************
'******************** insérer 4 lignes en haut de la feuille
For i = 1 To 4
Rows(1).Insert
Next i
'*************************
'******************** insérer une légende pour les priorités
'* Besoin URGENT = "priorité 1" F2
Range("F2:G2").Select
Selection.Interior.ColorIndex = 38 '**** rose
Range("F2").Select
ActiveCell.FormulaR1C1 = "* Besoin URGENT = 'priorité 1'"
'* En attente sur avion = " priorité 2" (pourrait devenir urgent) F3
Range("F3:G3").Select
Selection.Interior.ColorIndex = 35 '**** vert
Range("F3").Select
ActiveCell.FormulaR1C1 = "* En attente sur avion = 'priorité 2' (pourrait devenir urgent)"
'************************* insérer FILTRE AUTO
Range("A5:N5").Select
Selection.AutoFilter
'************************* mettre couleur (doré) titre colonnes
Range("A5:N5").Select
Selection.Interior.ColorIndex = 12
 
End Sub

Je voudrais mettre un truc du style : "appliquer cette macro a la feuille dant la cellule A est "Machin"

PS - Por l'avatar t'inquiete pas je vais le changer mais laa j'ai pas la temps :mouarf:

25/07/2009, 11h53
ouskel'n'or

Pas compris ton problème mais déjà, si tu utilises FormulaR1C1 (ex. : Range("M1").FormulaR1C1 = "Commentaire", ça ne rime à rien. Jète un oeil dans l'aide à
FormulaR1C1.
Tu pourrais utiliser un tas de chose mais pas ça. Text, Value, formula tout court... mais pas FormulaR1C1
En l'occurence, Range("M1")= "Commentaire" suffirait ;)
Corrige ton code et reviens-nous

NB - Pour l'avatar, si tu manques d'inspiration, je suis sûr que tu trouveras de nombreux volontaires pour t'en proposer un. Le tien est vraiment trop horrible :mouarf:

Bonjour,
tu pourrais mettre ta feuille à traiter en argument à ta macro..

Code:

1
2
3
4
5
6
Sub MiseEnForme(Wks As Worksheet)
    Wks.Select
    '..... code
    '..............
    '..............
End Sub

et ça sert à quoi ça ?

Code:

1
2
3
4
Range("M1").FormulaR1C1 = "Commentaire"
Range("M1").Value = "Commentaire"
Range("N1").FormulaR1C1 = "Priorité"
Range("N1").Value = "Priorité"

Ces deux lignes suffiront

Code:

1
2
Range("M1") = "Commentaire"
Range("N1") = "Priorité"

A+

26/07/2009, 21h34
FCL31
Citation:
Envoyé par LeForestier

tu pourrais mettre ta feuille à traiter en argument à ta macro..

Code:

1 2 3 4 5 6 Sub MiseEnForme(Wks As Worksheet) Wks.Select '..... code '.............. '.............. End Sub
Le problème c'est comment je peu choisir a quelle feuille j'applique la macro.
Dans le code, il y a des lignes qui suppriment des colonnes et je ne voudrais pas que sa en supprime sur des feuilles qui n'en on pas besoin.

C'est pourquoi, je voudrais un truc du style :
Appliquer la macro "MiseEnForme" à la feuille dont la cellules "A1" = "Truc"

Je sais pas si c'est possible mais je pense que oui mais je sais pas comment faire :oops: (je suis un peu naze :mouarf:)

PS - J'espère que mon avatar va mieux plaire même si il est pas génial

une façon de faire:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub MiseEnForme(Truc As Variant)
Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        If Wks.Range("A1") = Truc Then
            Wks.Activate
            GoTo Passe
        Exit For
    Next Wks
    MsgBox "Pas trouver de cellule A1 avec " & Truc
    Exit Sub
Passe:
    'Faire la macro
    '........
End Sub
 
Sub ExempleAppel()
    MiseEnForme "A trouver"
End Sub

A+

Selon les bons conseils de LeForestier j'ai fait :

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
 
Sub MiseEnForme()
Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        If Wks.Range("A1") = "Nº rés." Then
            Wks.Activate
            GoTo Passe
        Exit For
    Next Wks
    MsgBox "Pas trouver de cellule A1 avec " & "Nº rés."
    Exit Sub
Passe:
 
 
 
 
 
'****** effacer couleur jaunasse
Range("A2:K1000").Select
Selection.Interior.ColorIndex = xlNone
'******
 
Dim LigneTrackNegatif As Long
 
LigneTrackNegatif = 2
 
Do While LigneTrackNegatif <= 1000 And Cells(LigneTrackNegatif, 15).Value <> ""
 
    If Cells(LigneTrackNegatif, 15).Value < 0 Then
        Rows(LigneTrackNegatif).Delete
    End If
LigneTrackNegatif = LigneTrackNegatif + 1
 
Loop
 
'************** effacer colonnes inutiles
 
Range("A:A,B:B,M:M,O:O").Select
Selection.Delete
 
 
'*************effacer les lignes sans OF
Dim LigneTrackPasOF As Long
 
LigneTrackPasOF = 2
 
Do While LigneTrackPasOF <= 1000
 
    If Cells(LigneTrackPasOF, "A").Value = "" Then
        Rows(LigneTrackPasOF).Delete
    End If
LigneTrackPasOF = LigneTrackPasOF + 1
 
Loop
'*************************
 
'********** insérer colonne commentaire et priorité
'Range("M1").Select
'ActiveCell.FormulaR1C1 = "priorité"
 
'Range("N1").Select
'ActiveCell.FormulaR1C1 = "commentaire"
 
Range("M1").FormulaR1C1 = "Commentaire"
Range("M1").Value = "Commentaire"
 
Range("N1").FormulaR1C1 = "Priorité"
Range("N1").Value = "Priorité"
 
'*************************
 
'********** insérer dans colonne commentaire "Sans délais"
' si date prévue = VIDE ou =31/12/9999
 
Dim LigneTrackSansDelais As Long
 
LigneTrackSansDelais = 2
 
Do While LigneTrackSansDelais <= 1000
 
    If Cells(LigneTrackSansDelais, "L").Value = "" Or Cells(LigneTrackSansDelais, "L").Value = "31/12/9999" Then
        Cells(LigneTrackSansDelais, "M").Value = "Sans Délais"
    End If
LigneTrackSansDelais = LigneTrackSansDelais + 1
 
Loop
'*************************
'********** insérer dans colonne commentaire "Délais dépassé"
' si date prévue <= date du jour
Dim LigneTrackDelaisDepasse As Long
Dim MyDate
 
LigneTrackDelaisDepasse = 2
 
Do While LigneTrackDelaisDepasse <= 1000
    'MyDate = Cells(LigneTrackDelaisDepasse, 12).DateValue
    If Cells(LigneTrackDelaisDepasse, 12) <= Date And Cells(LigneTrackDelaisDepasse, 12) <> "" Then
        Cells(LigneTrackDelaisDepasse, 13).Value = "Délais dépassé"
    End If
LigneTrackDelaisDepasse = LigneTrackDelaisDepasse + 1
 
Loop
'*************************
 
'******************** insérer 4 lignes en haut de la feuille
For i = 1 To 4
Rows(1).Insert
Next i
'*************************
 
'******************** insérer une légende pour les priorités
'* Besoin URGENT = "priorité 1" F2
Range("F2:G2").Select
Selection.Interior.ColorIndex = 38 '**** rose
Range("F2").Select
ActiveCell.FormulaR1C1 = "* Besoin URGENT = 'priorité 1'"
 
'* En attente sur avion = " priorité 2" (pourrait devenir urgent) F3
Range("F3:G3").Select
Selection.Interior.ColorIndex = 35 '**** vert
Range("F3").Select
ActiveCell.FormulaR1C1 = "* En attente sur avion = 'priorité 2' (pourrait devenir urgent)"
 
'************************* insérer FILTRE AUTO
Range("A5:N5").Select
Selection.AutoFilter
'************************* mettre couleur (doré) titre colonnes
Range("A5:N5").Select
Selection.Interior.ColorIndex = 12
 
End Sub

Je sais pas si je me suis planté quelque par mais sa marche pas :(
Quelqu'un aurrai une idée ??

27/07/2009, 11h53
aalex_38

ça ne marche pas n'est pas très explicit :?

déja est-ce que tu passe bien dans le if quand les conditions te semblent réunies ?

Code:

If Wks.Range("A1") = "Nº rés."

En effet, une mauvaise casse (utilises UCASE), des espaces (utilises TRIM) peuvent poser problème.
27/07/2009, 12h07
ouskel'n'or

Juste une question au passage :
Ta feuille, elle n'a pas un nom ? Ce nom, ne le connais-tu pas ?
Parce que le plus simple pour travailler dans une feuille est d'utiliser son nom

Code:

Worksheets(LeNomDeLaFeuille).Blablabla

Y a une errur dans mon code et tu l'a retranscrite...

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub MiseEnForme()
Dim Wks As Worksheet
    For Each Wks In ActiveWorkbook.Worksheets
        If Wks.Range("A1") = "Nº rés." Then
            Wks.Activate
            GoTo Passe
        End If
    Next Wks
    MsgBox "Pas trouver de cellule A1 avec " & "Nº rés."
    Exit Sub
Passe:

End If à la place de Exit For
A+

S'il n'y a pas d'autre moyen de trouver le nom de la feuille alors je suis d'accord avec ta méthode, LeForestier, mais je suis du même avis qu'Alex, à savoir qu'une erreur de casse pourrait se produire. Aussi, au lieu de mettre ce que tu as mis, je mettrais ça
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub MiseEnForme() Dim Wks As Worksheet, ok as boolean For Each Wks In ActiveWorkbook.Worksheets ok = Ucase(Wks.Range("A1")) = Ucase("Nº rés.") If ok then NomDeLaFeuille = Wks.Name Wks.Activate exit for End If Next Wks If not ok then msgbox "feuille non trouvée" End sub
Oui ! Faut dire que j'ai horreur des goto :aie:

Pas fort en forme aujourd'hui Ousk ?:calim2:

Code:

1
2
3
4
      If ok then NomDeLaFeuille = Wks.Name
            Wks.Activate
            exit for
        End If

Ce serait pas plutôt :

Code:

1
2
3
4
5
6
       If ok then 
'Mais je vois pas pourquoi il aurrai besoin du nom de la feuille ?
             NomDeLaFeuille = Wks.Name
            Wks.Activate
            exit for
        End If

:frenchy:
A+

27/07/2009, 13h01
ouskel'n'or

Hello l'homme des bois,
Tu as raison mais... tu as reçu mon mp ?
27/07/2009, 13h25
FCL31

C'est bon sa marche :ccool:

Désolé ouskel'n'or j'ai pris le code l'homme des bois comme tu dit.
Surtout parce que c'était le premier proposé.

Toutefois, il m'a fallu supprimer

Code:

MsgBox "Pas trouver de cellule A1 avec " & "Nº rés."

Sinon sa me l'affichait a chaque fois.

J'avais aussi oublié de mettre

Code:

Call MiseEnForme

Mais bon maintenant sa marche :yaisse2:

En tout cas MERCI à tous

:merci:
27/07/2009, 13h46
ouskel'n'or

Citation:

Envoyé par FCL31

Désolé ouskel'n'or j'ai pris le code l'homme des bois

C'est bien fait ! Comme ça tu as un goto qui ne sert plus à rien :langue:
27/07/2009, 14h02
LeForestier

Re tous,

Citation:

Sinon sa me l'affichait a chaque fois.

Je pense qu'il faut comprendre.. à chaque fois que la condition n'est pas remplie.
PS: S'il a un goto en plus... il a deux variables en moins.. ;)
A+
Edit : Et n'oublie pas Svp, le bouton RESOLU si le topic est terminer.