Tester l'existance d'un classeur

[nsqualli]

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:

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

 

[porcinet82]

Re : Tester l'existance d'un classeur

Salut,

Je n'ai pas regardé ton code ou tes fichiers, mais pour tester l'existence d'un fichier dans un répetoire connu, tu peux utiliser le code suivant :

Sub test()
Dim Chemin As String, Txt As String
Dim Nom_fichier_cherche As String
Nom_fichier_cherche = "Nom_du_fichier.xls" 'modif ici
Chemin = "C:\Documents and Settings\" & Environ("username") & "\Bureau\"
Txt = Dir(Chemin & Nom_fichier_cherche)
If Not Txt = "" Then
    rep = MsgBox("Le fichier """ & Nom_fichier_cherche & """ existe déjà, voulez-vous l'écraser ?", vbInformation + vbYesNo, "")
    If rep = vbNo Then
        MsgBox "Le reste de la macro ne sera pas exécuté !", vbExclamation + vbOKOnly, ""
        End
    Else
        Kill Chemin & Nom_fichier_cherche
    End If
End If
End Sub

Pour ce code, il faut spécifier le chemin du répertoire (et bien entendu du fichier cherché) et ensuite, il regarde s'il existe ou non et te propose de le supprimer.

Je pense que tu devrais arriver a l'adapter sans mal.

@+