Probleme avec un indice

**nsqualli** · 08/01/2009, 12h40

Bonjour,

dans le cadre de mon stage, je suis entrain de faire une macro, qui fait la comparaison de certaines données.

j'ai :
-un classeur "TMA RCV" qui contient plusieurs feuilles (chaque feuille correspond a une ressource humaine.
-un dossier "RMA" qui contient plusieurs classeurs ou chaque classeur est composé d'une seule feuille (correspond a une ressource)
ce que j'ai fais, c'est de creer un autre classeur,qui esr composé d'une feuille de parametrage "Parametres" ou l'utilisateur va mettre les chemins du classeur et dossier précités, et un bouton qui lance le traitement de comparaison.

le traitement se fait de la maniere suivante:
-ouvre le classeur "TMA RCV", et fait une boucle sur toutes les feuilles (les noms des feuilles correspondent aux noms des ressources), il se place sur la premiere feuille,
Apres
-ouvre le premier classeur dans le dossier "RMA", et teste sur les noms des ressources, si les noms sont egaux, il teste sur certaine dates....

l'essentiel c que a un certain moment quand une condition est verifiée il doit creer une feuille "Liste" dans le classeur de parametrage et le remplir si la feuille "liste" n'existe pas, sinon l'ouvrir et la remplir a partir de la premier ligne vide.

j'ai le code dessous, il crée la feuille "Liste", la rempli pour la premiere ressource du classeur "TMA RCV" apres il beugue au niveau de la ligne :

Code :

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

Set feuilleCRAH = Sheets(NomFeuille1)

L'indice n'appartient pas a la selection.

voila le code:

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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
Option Explicit
Option Compare Text
 
Sub verifier()
'*************************************************************************************************************************
'                                               Déclarations
'*************************************************************************************************************************
Dim fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
 
Dim wb As Workbook
 
Dim feuille As Worksheet
Dim feuilleCRAH As Worksheet
Dim FeuilListe As Worksheet
Dim feuilleparam As Worksheet
 
Dim NomFeuille As String, NomFeuille1 As String
Dim NomRessource As String, NomRessource1 As String, NomRessource2 As String
Dim PrenomRessource As String
Dim RepertoireRMA As String, Repertoirecrah As String, NomClasseur As String
Dim NomFichier As String, NomFichier1 As String, NomFichier2 As String, NomFichier3 As String
Dim Chemin As String
Dim ClasseurNom As String
 
Dim DateCrah As Variant, DateCRAH1 As Variant
Dim DateRMA As Variant, DateRMA1 As Variant
 
Dim ColCRAH As Long, DerColCRAH As Long
Dim ColRMA As Long, DerColRMA As Long
Dim LigRMA As Long
Dim DerLigListe As Long
 
Dim i As Integer
 
Dim b_existe As Boolean
 
Dim ValCelRMA As Double, ValCelRMA1 As Double
Dim SommeRma As Double
Dim SommeCrah As Double, SommeCRAH1 As Double
'*************************************************************************************************************************
'                                               Traitements
'*************************************************************************************************************************
RepertoireRMA = Sheets("Parametres").Range("B" & 1).Value
Repertoirecrah = Sheets("Parametres").Range("B" & 2).Value
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(RepertoireRMA)
 
ClasseurNom = ThisWorkbook.Name
 
'ouvrir le classeur des CRAH
Workbooks.Open (Repertoirecrah)
 
'boucle sur toutes les feuilles du classeur
For Each feuille In Application.ActiveWorkbook.Worksheets
 
    'recuperer le nom de la ressource a partir du nom de la feuille CRAH, et enlever les espaces
    NomFeuille1 = feuille.Name
    NomFeuille = Replace(NomFeuille1, " ", "")
 
    Set feuilleCRAH = Sheets(NomFeuille1)
 
    'boucle sur tous les RMA
    For Each FileItem In SourceFolder.Files
 
        'recuperer le chemin complet du classeur RMA
        NomFichier = FileItem.Name
        Chemin = RepertoireRMA & NomFichier
 
        'extraire le Nom de la ressource a partir du nom du classeur
        NomFichier1 = nom(NomFichier)
        NomFichier2 = Replace(NomFichier1, " ", "")
        NomFichier3 = Replace(NomFichier2, "-", "")
 
        If NomFichier3 = NomFeuille Then
 
            'ouvrir les RMA
            Workbooks.Open (Chemin)
 
            'recuperer les noms des ressources des RMA, en enlevant les espaces et les '-'
            NomRessource1 = Workbooks(NomFichier).Worksheets("Feuil1").Range("B" & 3).Value
            NomRessource2 = Replace(NomRessource1, " ", "")
            NomRessource = Replace(NomRessource2, "-", "")
 
            'recuperer les prenoms des ressources des RMA
            PrenomRessource = Workbooks(NomFichier).Worksheets("Feuil1").Range("B" & 2).Value
 
            'recuperer la derniere colonne du RMA
            DerColRMA = Workbooks(NomFichier).Worksheets("Feuil1").Cells(7, 4).End(xlToRight).Column
 
                'tester si le nom du RMA et CRAH sont egaux
                If NomFeuille = NomRessource Then
 
                    'recuperer la derniere colonne non vide du CRAH
                    DerColCRAH = feuilleCRAH.Cells(2, 3).End(xlToRight).Column
 
                    'boucle les dates du CRAH
                    For ColCRAH = 4 To DerColCRAH - 4
 
                        DateCRAH1 = feuilleCRAH.Cells(2, ColCRAH).Value
                        DateCrah = Right(DateCRAH1, 2)
 
                        'Boucle sur les dates du RMA
                        For ColRMA = 4 To DerColRMA
                            'feuilleCRAH.Activate
                            DateRMA1 = Workbooks(NomFichier).Worksheets("Feuil1").Cells(7, ColRMA).Value
 
                            'recuperer la date du RMA a travers la fonction tester
                            DateRMA = tester(DateRMA1)
 
                            'tester si la date du CRAH et du RMA sont egaux
                            If DateCrah = DateRMA Then
                                If Workbooks(NomFichier).Worksheets("Feuil1").Cells(7, ColRMA).Interior.ColorIndex = 6 Then
                                    Else
                                        SommeRma = 0
                                            For LigRMA = 9 To 28
                                                If Workbooks(NomFichier).Worksheets("Feuil1").Cells(LigRMA, ColRMA).Value <> " " Then
                                                    ValCelRMA1 = Workbooks(NomFichier).Worksheets("Feuil1").Cells(LigRMA, ColRMA).Value
                                                    ValCelRMA = Replace(ValCelRMA1, " ", "")
                                                    SommeRma = SommeRma + ValCelRMA
                                                End If
                                            Next LigRMA
                                        SommeCRAH1 = feuilleCRAH.Cells(50, ColCRAH).Value
                                        SommeCrah = Replace(SommeCRAH1, " ", "")
                                        If SommeRma = SommeCrah Then
                                            'ne rien faire
                                            Else
                                                Workbooks(ClasseurNom).Activate
 
                                                If FeuilleExiste("Liste") = True Then
 
                                                    Set FeuilListe = Sheets("Liste")
 
                                                    'recupere la derniere ligne non vide de la nouvele liste
                                                    DerLigListe = FeuilListe.Range("A" & Rows.Count).End(xlUp).Row
 
                                                    'inserer le nom, le prenom, la date, l'imputation CRAH et l'imputation RMA dans la liste
                                                    FeuilListe.Range("A" & DerLigListe + 1).Value = NomRessource
                                                    FeuilListe.Range("B" & DerLigListe + 1).Value = PrenomRessource
                                                    FeuilListe.Range("C" & DerLigListe + 1).Value = DateCRAH1
                                                    FeuilListe.Range("D" & DerLigListe + 1).Value = SommeCrah
                                                    FeuilListe.Range("E" & DerLigListe + 1).Value = SommeRma
 
                                                    Else
 
                                                        Sheets.Add After:=Worksheets(Worksheets.Count)
                                                        ActiveSheet.Name = "Liste"
 
                                                        Set FeuilListe = Sheets("Liste")
 
                                                        'creer l'entete de la liste
                                                        FeuilListe.Range("A" & 1).Formula = "Nom"
                                                        FeuilListe.Range("A" & 1).Font.Bold = True
                                                        FeuilListe.Columns("A:A").ColumnWidth = 20#
 
                                                        FeuilListe.Range("B" & 1).Formula = "Prénom"
                                                        FeuilListe.Range("B" & 1).Font.Bold = True
                                                        FeuilListe.Columns("B:B").ColumnWidth = 17#
 
                                                        FeuilListe.Range("C" & 1).Formula = "Jour"
                                                        FeuilListe.Range("C" & 1).Font.Bold = True
 
                                                        FeuilListe.Range("D" & 1).Formula = "Imputation CRAH"
                                                        FeuilListe.Range("D" & 1).Font.Bold = True
                                                        FeuilListe.Columns("D:D").ColumnWidth = 17#
 
                                                        FeuilListe.Range("E" & 1).Formula = "Imputation RMA"
                                                        FeuilListe.Range("E" & 1).Font.Bold = True
                                                        FeuilListe.Columns("E:E").ColumnWidth = 17#
 
                                                        'recuperer la derniere ligne non vide de la liste
                                                        DerLigListe = FeuilListe.Range("A" & Rows.Count).End(xlUp).Row
 
                                                        'inserer le nom, le prenom, la date, l'imputation CRAH et l'imputation RMA dans la liste
                                                        FeuilListe.Range("A" & DerLigListe + 1).Value = NomRessource
                                                        FeuilListe.Range("B" & DerLigListe + 1).Value = PrenomRessource
                                                        FeuilListe.Range("C" & DerLigListe + 1).Value = DateCRAH1
                                                        FeuilListe.Range("D" & DerLigListe + 1).Value = SommeCrah
                                                        FeuilListe.Range("E" & DerLigListe + 1).Value = SommeRma
 
                                                End If
                                        End If
                                End If
                            End If
                        Next ColRMA
                    Next ColCRAH
                End If
            'fermer le RMA
            Workbooks(NomFichier).Close savechanges:=False
        End If
    Next
Next feuille
 
End Sub

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
Function FeuilleExiste(Nom_Feuille As String) As Boolean
Dim x As Object
Dim NomFeuille As String
 
NomFeuille = Nom_Feuille
 
On Error Resume Next
 
Set x = ActiveWorkbook.Sheets(NomFeuille)
 
If Err = 0 Then
    FeuilleExiste = True
    Else
        FeuilleExiste = False
End If
 
End Function

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
Function tester(Date_RMA As Variant) As Variant
 
Dim DateRMA1 As Variant, DateRMA As Variant
 
'recuperer la date de l'RMA
DateRMA1 = Date_RMA
 
'si la date est entre 1 et 9
If Len(DateRMA1) = 1 Then
    DateRMA = "0" & DateRMA1
 
    'renvoyer la date
    tester = DateRMA
End If
 
'si la date est entre 10 et 28, 29, 30 ou 31
If Len(DateRMA1) = 2 Then
    DateRMA = "" & DateRMA1
 
    'renvoyer la date
    tester = DateRMA
End If
 
End Function

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function nom(Nom_fichier As String) As String
 
Dim NomFichier As String, Nchaine As String, Ndebut As String, Nfin As String, f1nom As String
 
NomFichier = Nom_fichier
 
Nchaine = NomFichier
Ndebut = InStr(1, Nchaine, " ", vbTextCompare) + 1
Nfin = InStr(1, Nchaine, "_", vbTextCompare)
f1nom = Mid(Nchaine, Ndebut, Nfin - Ndebut)
 
nom = f1nom
 
End Function

**pgz** · 08/01/2009, 13h22

Bonjour.

Si tu as plusieurs classeurs ouverts, tu as plusieurs collections Sheets. Tu dois préciser dans quel classeur tu cherches la feuille. ThisWorkbook désigne le classeur contenant le code qui s'exécute. Tu devrais créer une instance de l'autre classeur

Code :

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

Set wbk = ...

et ensuite,

Code :

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

Set feuilleCRAH = wbk.Sheets(NomFeuille1)

PGZ

**nsqualli** · 08/01/2009, 13h30

j'ai essayé cela:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Workbooks.Open (Repertoirecrah)
 
'boucle sur toutes les feuilles du classeur
For Each feuille In Application.ActiveWorkbook.Worksheets
 
    'recuperer le nom de la ressource a partir du nom de la feuille CRAH, et enlever les espaces
    NomFeuille1 = feuille.Name
    NomFeuille = Replace(NomFeuille1, " ", "")
 
    Set wbk = ActiveWorkbook
 
     (2)   Set feuilleCRAH = wbk.Sheets(NomFeuille1)
...

mais ça marche toujours pas:
l'indice n'appartient pas a la selection a la ligne (2)

**pgz** · 08/01/2009, 15h26

Essaies plutôt d'instancier tout de suite le classeur, pas dans l'éumération.

Code :

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

1
2
3
4
5
6
7
8
9
10
Set wbk = Application.Workbooks.Open(Repertoirecrah)
 
'boucle sur toutes les feuilles du classeur
For Each feuille In wbk.Worksheets
 
    'recuperer le nom de la ressource a partir du nom de la feuille CRAH, et enlever les espaces
    NomFeuille1 = feuille.Name
    NomFeuille = Replace(NomFeuille1, " ", "")
 
    Set feuilleCRAH = feuille 'cela sert-il à quelque chose, on a déjà feuille!

'feuille' te sert à énumérer les feuilles de wbk. Voir s'il y a vraiment besoin de feuilleCRAH, puisque tu as déjà 'feuille'.

Vois-tu?

PGZ

**nsqualli** · 08/01/2009, 15h41

Merci bcp, ça marche tres bien.
tu m'as sauvé la vie

Probleme avec un indice

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager