Tester l'existance d'un classeur
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 Subla 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
https://www.excel-pratique.com/~files/doc/TMA1.xls
https://www.excel-pratique.com/~files/doc/_RMA1_XXX_RMA_12_08.xls