Tester l'existence d'un classeur

**nsqualli** · 06/01/2009, 10h31

Bonjour,

je suis entrain d'ecrire une macro qui fait la chose suivante:

-a partir d'un classeur "TMA" qui contient des feuilles au nombre de ressource humaine(chaque ressource a une feuille ou dans la ligne 50 elle le nombre d'absence)(feuille jointe TMA1) et d'un repertoire qui contient des classeurs ( un classeur par ressource)(feuille jointe RMA1) qui contient le planning d'un mois

je dois faire une comparaison (pour la meme ressource, et le meme jour) si la cellule D50 de la TMA1 est egal a la somme des cellules K9 à K28 de la feuille RMA1, si oui alors ne rien faire, si il ne sont pas egaux je dois créer un classeur dans un endroit precis( que je precise a la cellule C56 de la feuille TMA1.

mon probleme est le suivant:

c'est quand le classeur est deja créé suite a un traitement anterieur, comment je peux faire cela?

voila mon code que j'ai mis dans le classeur TMA1:

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
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 feuille As Worksheet
Dim feuilleRMA As Worksheet
Dim feuilleCRAH As Worksheet
Dim feuilleDST As Worksheet
Dim CheminListe As String
 
Dim NomFeuille As String, NomFeuille1 As String
Dim NomRessource As String, NomRessource1 As String, NomRessource2 As String
Dim PrenomRessource As String
Dim Repertoire As String
Dim NomFichier As String
Dim Chemin As String, CheminVerif As String, CheminVerif1 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 ValCelRMA As Double, ValCelRMA1 As Double
Dim SommeRma As Double
Dim SommeCrah As Double, SommeCRAH1 As Double
 
 
'*************************************************************************************************************************
'                                               Traitements
'*************************************************************************************************************************
Repertoire = Sheets("Parametres").Range("B" & 1).Value
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = fso.GetFolder(Repertoire)
 
 
'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
        NomFichier = FileItem.Name
        Chemin = Repertoire & NomFichier
 
        Workbooks.Open (Chemin)
        'Windows(NomFichier).Visible = False
 
        NomRessource1 = Workbooks(NomFichier).Worksheets("Feuil1").Range("B" & 3).Value
        NomRessource2 = Replace(NomRessource1, " ", "")
        NomRessource = Replace(NomRessource2, "-", "")
 
        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
 
            If NomFeuille = NomRessource Then
 
                DerColCRAH = feuilleCRAH.Cells(2, 3).End(xlToRight).Column
 
                For ColCRAH = 4 To DerColCRAH - 4
 
                    DateCRAH1 = feuilleCRAH.Cells(2, ColCRAH).Value
                    DateCrah = Right(DateCRAH1, 2)
 
                    For ColRMA = 4 To DerColRMA
                        feuilleCRAH.Activate
                        DateRMA1 = Workbooks(NomFichier).Worksheets("Feuil1").Cells(7, ColRMA).Value
                        If Len(DateRMA1) = 1 Then
                            DateRMA = "0" & DateRMA1
 
                            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
                                                Call creer(ActiveWorkbook.Name, NomFeuille1, NomRessource1, PrenomRessource, DateCRAH1, SommeCrah, SommeRma)
                                        End If
                                End If
                            End If
 
                            ElseIf Len(DateRMA1) = 2 Then
                                DateRMA = "" & DateRMA1
                                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
                                                    Call creer(ActiveWorkbook.Name, NomFeuille1, NomRessource1, PrenomRessource, DateCRAH1, SommeCrah, SommeRma)
                                            End If
                                    End If
                                End If
                        End If
                    Next ColRMA
                Next ColCRAH
            End If
        Workbooks(NomFichier).Close SaveChanges:=False
    Next
Next feuille
 
End Sub

la fonction creer, crée le nouveau classeur, et c la ou je veux faire le teste de l'existance du classeur et le remplire

Merci

**Pierre Fauconnier** · 06/01/2009, 10h57

Bonjour

Code :

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

Dir("MonClasseur")

renvoie une chaine vide si le classeur n'existe pas et le nom + extension du classeur s'il existe. Tu peux donc tester si Dir renvoie une chaine vide.

en adaptant bien sûr "MonClasseur" par le nom (chemin complet + extension) du classeur recherché.

**nsqualli** · 06/01/2009, 11h32

et apres comment je peux acceder a ce classeur?
j'ai essayé ceci :

Code :

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

DerLigListe = Workbooks("Vérification CRAH.xls").Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row

mais ça marche pas

**nsqualli** · 06/01/2009, 11h36

voila le code que j'ai fais pour la fonction creer:

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
Function creer(Nom_Fichier As String, Nom_Feuille As String, Nom As String, Prenom As String, DateCrah As Variant, SommeCrah As Double, SommeRma As Double)
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
 
Dim fso1 As Object, x As Boolean
 
Dim DerLigListe As Long
 
Dim CheminVerif As String
Dim NomFichier As String
Dim NomFeuille As String
Dim NomRes As String, PrenomRes As String
Dim DateC As Variant
Dim SommeC As Double, SommeR As Double
 
'recuperer les données : nom, prenom, date, imputaion CRAH et RMA
NomFichier = Nom_Fichier
NomFeuille = Nom_Feuille
NomRes = Nom
PrenomRes = Prenom
DateC = DateCrah
SommeC = SommeCrah
SommeR = SommeRma
 
'creer l'objet fso1 pour le listing des fichiers
Set fso1 = CreateObject("Scripting.FileSystemObject")
 
'recuperer l'emplacement du nouveau classeur
CheminVerif = Sheets("Parametres").Range("B" & 2).Value
 
'tester l'existance du nouveau classeur
x = fso1.FileExists(CheminVerif & "Vérification CRAH.xls")
 
'Set feuille = Workbooks("Vérification CRAH").Sheets("Liste")
 
If Dir(CheminVerif & "Vérification CRAH.xls") = "Vérification CRAH.xls" Then
    MsgBox ("c bon")
 
    DerLigListe = Workbooks("Vérification CRAH.xls").Worksheets("Liste").Range("A" & Rows.Count).End(xlUp).Row
 
    Workbooks("Vérification CRAH.xls").Worksheets("Liste").Range("A" & DerLigListe + 1).Value = NomRes
    Workbooks("Vérification CRAH.xls").Worksheets("Liste").Range("B" & DerLigListe + 1).Value = PrenomRes
    Workbooks("Vérification CRAH.xls").Worksheets("Liste").Range("C" & DerLigListe + 1).Value = DateC
    Workbooks("Vérification CRAH.xls").Worksheets("Liste").Range("D" & DerLigListe + 1).Value = SommeC
    Workbooks("Vérification CRAH.xls").Worksheets("Liste").Range("E" & DerLigListe + 1).Value = SommeR
 
    ElseIf Dir(CheminVerif & "Vérification CRAH.xls") = "" Then
 
        'On créer l'objet Excel
        Set xlApp = CreateObject("Excel.Application")
        'On défini le nombre d'onglets
        xlApp.SheetsInNewWorkbook = 1
        'On ajoute un classeur
        Set xlBook = xlApp.Workbooks.Add
        'ActiveWorkbook.SaveAs 'CheminVerif & "Vérification CRAH.xls"
        'On donne un nom au classeur
        xlBook.SaveAs CheminVerif & ("Vérification CRAH.xls")
        'On rend le classeur visible
        xlApp.Visible = True
        'On créer l'objet onglet dans le nouveau classeur créé
        Set xlSheet = xlBook.Worksheets(1)
        'On affecte un nom aux l'onglets
        xlSheet.Name = "Liste"
 
        xlSheet.Range("A" & 1).Formula = "Nom"
        xlSheet.Range("A" & 1).Font.Bold = True
 
        xlSheet.Range("B" & 1).Formula = "Prénom"
        xlSheet.Range("B" & 1).Font.Bold = True
 
        xlSheet.Range("C" & 1).Formula = "Jour"
        xlSheet.Range("C" & 1).Font.Bold = True
 
        xlSheet.Range("D" & 1).Formula = "Imputation CRAH"
        xlSheet.Range("D" & 1).Font.Bold = True
        xlSheet.Columns("D:D").ColumnWidth = 17#
 
        xlSheet.Range("E" & 1).Formula = "Imputation RMA"
        xlSheet.Range("E" & 1).Font.Bold = True
        xlSheet.Columns("E:E").ColumnWidth = 17#
 
        DerLigListe = xlSheet.Range("A" & Rows.Count).End(xlUp).Row
 
        xlSheet.Range("A" & DerLigListe + 1).Value = NomRes
        xlSheet.Range("B" & DerLigListe + 1).Value = PrenomRes
        xlSheet.Range("C" & DerLigListe + 1).Value = DateC
        xlSheet.Range("D" & DerLigListe + 1).Value = SommeC
        xlSheet.Range("E" & DerLigListe + 1).Value = SommeR
End If
 
End Function

lors de l'execution, apres le premier enregistrement c-a-dire apres qu'il crée le nouveau classeur ça me donne une erreur d'xecution 9 'l'indice n'appartient pas a la selection.

comment je dois m'y prendre?

**Pierre Fauconnier** · 06/01/2009, 11h40

S ton classeur n'est pas structuré comme une base de données, tu n'as pas d'autre choix que l'ouvrir

Code :

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

1
2
dim wb as workbook
set wb=workbooks.open(...)

en remplaçant les ... par le nom complet (chemin complet + nom + extension) puis de manipuler l'objet wb en préfixe aux feuilles que tu veux manipuler

Dans ton exemple

Code :

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

1
2
3
dim wb as workbook
set wb=workbooks.open("Vérification CRAH.xls")
DerLigListe = wb.Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row

en n'omettant pas le chemin du classeur sur l'instruction Open

**nsqualli** · 06/01/2009, 11h49

j'ai essayé , mais il me crée un autre classeur, tout en me donnant une erreur '2147221080(800401a8) erreur automation.

voila le code de la fonction creer:

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
 
Function creer(Nom_Fichier As String, Nom_Feuille As String, Nom As String, Prenom As String, DateCrah As Variant, SommeCrah As Double, SommeRma As Double)
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim wb1 As Workbook
 
Dim fso1 As Object
 
Dim DerLigListe As Long
 
Dim CheminVerif As String
Dim NomFichier As String
Dim NomFeuille As String
Dim NomRes As String, PrenomRes As String
Dim DateC As Variant
Dim SommeC As Double, SommeR As Double
 
'recuperer les données : nom, prenom, date, imputaion CRAH et RMA
NomFichier = Nom_Fichier
NomFeuille = Nom_Feuille
NomRes = Nom
PrenomRes = Prenom
DateC = DateCrah
SommeC = SommeCrah
SommeR = SommeRma
 
'creer l'objet fso1 pour le listing des fichiers
Set fso1 = CreateObject("Scripting.FileSystemObject")
 
'recuperer l'emplacement du nouveau classeur
CheminVerif = Sheets("Parametres").Range("B" & 2).Value
 
'tester l'existance du nouveau classeur
x = fso1.FileExists(CheminVerif & "Vérification CRAH.xls")
 
If Dir(CheminVerif & "Vérification CRAH.xls") = "Vérification CRAH.xls" Then
 
    MsgBox ("c bon")
 
    Set wb1 = Workbooks.Open(CheminVerif & "Vérification CRAH.xls")
 
    DerLigListe = wb1.Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row
 
    wb1.Sheets("Liste").Range("A" & DerLigListe + 1).Value = NomRes
    wb1.Sheets("Liste").Range("B" & DerLigListe + 1).Value = PrenomRes
    wb1.Sheets("Liste").Range("C" & DerLigListe + 1).Value = DateC
    wb1.Sheets("Liste").Range("D" & DerLigListe + 1).Value = SommeC
    wb1.Sheets("Liste").Range("E" & DerLigListe + 1).Value = SommeR
 
    ElseIf Dir(CheminVerif & "Vérification CRAH.xls") = "" Then
 
        'On créer l'objet Excel
        Set xlApp = CreateObject("Excel.Application")
        'On défini le nombre d'onglets
        xlApp.SheetsInNewWorkbook = 1
        'On ajoute un classeur
        Set xlBook = xlApp.Workbooks.Add
        'ActiveWorkbook.SaveAs 'CheminVerif & "Vérification CRAH.xls"
        'On donne un nom au classeur
        xlBook.SaveAs CheminVerif & ("Vérification CRAH.xls")
        'On rend le classeur visible
        xlApp.Visible = True
        'On créer l'objet onglet dans le nouveau classeur créé
        Set xlSheet = xlBook.Worksheets(1)
        'On affecte un nom aux l'onglets
        xlSheet.Name = "Liste"
 
        xlSheet.Range("A" & 1).Formula = "Nom"
        xlSheet.Range("A" & 1).Font.Bold = True
 
        xlSheet.Range("B" & 1).Formula = "Prénom"
        xlSheet.Range("B" & 1).Font.Bold = True
 
        xlSheet.Range("C" & 1).Formula = "Jour"
        xlSheet.Range("C" & 1).Font.Bold = True
 
        xlSheet.Range("D" & 1).Formula = "Imputation CRAH"
        xlSheet.Range("D" & 1).Font.Bold = True
        xlSheet.Columns("D:D").ColumnWidth = 17#
 
        xlSheet.Range("E" & 1).Formula = "Imputation RMA"
        xlSheet.Range("E" & 1).Font.Bold = True
        xlSheet.Columns("E:E").ColumnWidth = 17#
 
        DerLigListe = xlSheet.Range("A" & Rows.Count).End(xlUp).Row
 
        xlSheet.Range("A" & DerLigListe + 1).Value = NomRes
        xlSheet.Range("B" & DerLigListe + 1).Value = PrenomRes
        xlSheet.Range("C" & DerLigListe + 1).Value = DateC
        xlSheet.Range("D" & DerLigListe + 1).Value = SommeC
        xlSheet.Range("E" & DerLigListe + 1).Value = SommeR
End If
 
End Function

**Pierre Fauconnier** · 06/01/2009, 11h53

Il ne manquerait pas un \ entre le chemin et le nom du fichier...

De plus, tu testes l'existence avec FSO puis avec DIR...

Il faudrait d'abord nettoyer ta macro pour y voir plus clair

Tester l'existence d'un classeur

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager