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 :
L'indice n'appartient pas a la selection.
voila le code:
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:
Set feuilleCRAH = Sheets(NomFeuille1)L'indice n'appartient pas a la selection.
voila le code:
Code:
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:
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:
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:
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