Discussion :

[FCL31]

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

[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

[FCL31]

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

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

[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

[LeForestier]

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

Code :

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

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

et ça sert à quoi ça ?

Code :

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

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 :

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

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

A+

[FCL31]

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

Code :

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

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 (je suis un peu naze )


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

[LeForestier]

une façon de faire:

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
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+

[FCL31]

Selon les bons conseils de LeForestier j'ai fait :

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
 
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 ??

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

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

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

En effet, une mauvaise casse (utilises UCASE), des espaces (utilises TRIM) peuvent poser problème.

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

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

Worksheets(LeNomDeLaFeuille).Blablabla

[LeForestier]

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

Code :

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

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+

[ouskel'n'or]

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 :

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

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

[LeForestier]

Pas fort en forme aujourd'hui Ousk ?

Code :

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

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

Ce serait pas plutôt :

Code :

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

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

A+

[ouskel'n'or]

Hello l'homme des bois,
Tu as raison mais... tu as reçu mon mp ?

[FCL31]

C'est bon sa marche

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 :

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

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 :

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

Call MiseEnForme

Mais bon maintenant sa marche

En tout cas MERCI à tous

[ouskel'n'or]

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

[LeForestier]

Re tous,

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.