Afficher pour chaque evenement le personne
Résolu
hajars
Messages postés
38
Statut
Membre
-
thev Messages postés 2005 Date d'inscription Statut Membre Dernière intervention -
thev Messages postés 2005 Date d'inscription Statut Membre Dernière intervention -
Bonjour le Forum,
Je dois créer un fichier CSV avec des informations sur les salariés et leurs congés
En fait, mon tableau doit avoir une ligne pour chaque congé pris par un salarié cad si un salarié a pris deux conges en un mois je dois avoir sur mon tableau 2 fois son nom avec les informations qui vont avec qui seront son nom et prenom, le code de l entreprise, son matricule le code du congé la date de debut la date de fin plage de debut(journee matin aprem) plage de fin
le probleme c est que la feuille ou il y a chaque salarié et ses congés est sous forme de tableaux avec des codes couleurs (capture1)
et la feuille ou il y a les codes rubriques c est une autre feuille.(capture 2)
Voila le tableau que j'ai pour le moment
et le code qui me sort ce tableau
Je vois pas comment je pourrai faire pour dire en vba Pour chaque congé ajouter une ligne d'un salarié ni comment recuperer les dates et les codes parce que c'est pas du texte c est des couleurs.
Ci-joint les captures 1 et 2
capture1 c est la feuille planning_conges.xls ou il y a le nom des salariés les congés qu ils ont eu le type du congé la date la plage
Chaque cellule est soit disant composé en deux (matin, apresmidi)
Capture2 c est la feuille rubrique où il y a le code rubrique des code congés et le libellé
SI vous avez des idées ou des astuces dites moi s'il vous plait
Merci beaucoup
Je dois créer un fichier CSV avec des informations sur les salariés et leurs congés
En fait, mon tableau doit avoir une ligne pour chaque congé pris par un salarié cad si un salarié a pris deux conges en un mois je dois avoir sur mon tableau 2 fois son nom avec les informations qui vont avec qui seront son nom et prenom, le code de l entreprise, son matricule le code du congé la date de debut la date de fin plage de debut(journee matin aprem) plage de fin
le probleme c est que la feuille ou il y a chaque salarié et ses congés est sous forme de tableaux avec des codes couleurs (capture1)
et la feuille ou il y a les codes rubriques c est une autre feuille.(capture 2)
Voila le tableau que j'ai pour le moment
et le code qui me sort ce tableau
Sub Presentation()
With Worksheets("nombredetr")
.Cells.Clear
.Columns("A:A").ColumnWidth = 25
.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Date de début"
.Range("F1").Value = "Date de Fin"
.Range("G1").Value = "Plage de début"
.Range("H1").Value = "Plage de Fin"
Set nombredetr_A2 = .Range("A2") 'première cellule à remplir
End With
With Worksheets("nombredetr").Range("A1:H1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Worksheets("nombredetr").Range("A1:H1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
With Worksheets("Détails").UsedRange 'plage utilisée
J = 0
For I = 2 To .Rows.Count
If .Range("C" & I) <> "" Then
nombredetr_A2.Offset(J) = .Range("A" & I) & " " & .Range("B" & I)
J = J + 1
End If
Next I
For I = 2 To .Rows.Count
Worksheets("nombredetr").Range("B" & I).Value = "vatcode"
Next
J = 2
For I = 2 To .Rows.Count
If Worksheets("Détails").Range("C" & I) <> "" Then
Worksheets("nombredetr").Range("C" & J) = Worksheets("Détails").Range("C" & I)
J = J + 1
End If
Next I
End With
End Sub
Je vois pas comment je pourrai faire pour dire en vba Pour chaque congé ajouter une ligne d'un salarié ni comment recuperer les dates et les codes parce que c'est pas du texte c est des couleurs.
Ci-joint les captures 1 et 2
capture1 c est la feuille planning_conges.xls ou il y a le nom des salariés les congés qu ils ont eu le type du congé la date la plage
Chaque cellule est soit disant composé en deux (matin, apresmidi)
Capture2 c est la feuille rubrique où il y a le code rubrique des code congés et le libellé
SI vous avez des idées ou des astuces dites moi s'il vous plait
Merci beaucoup
| EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI Merci d'y penser dans tes prochains messages. |
15 réponses
-
bonsoir,
ci-dessous proposition de code pour récupérer les congés payés
Ajouter référence Microsoft Scripting Runtime
Sub Presentation()
'..... Déclaration variables
Dim dates() ' tableau des dates
Dim nbtr_A2H2 As Range ' plage A2:H2 de la feuille "nombredetr"
Dim codes_salariés As New Dictionary ' dictionnaire des codes salariés
Dim CP1 As Range, CP As Range
Dim nom_prénom As String, date_début As String, date_fin As String
Dim CP_col_prec As Integer
Dim date_début_OK As Boolean
'..... initialisation de la feuille "nombredetr"
With Worksheets("nombredetr")
.Cells.Clear
.Columns("A:A").ColumnWidth = 25
.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Date de début"
.Range("F1").Value = "Date de Fin"
.Range("G1").Value = "Plage de début"
.Range("H1").Value = "Plage de Fin"
Set nbtr_A2H2 = .Range("A2:H2") 'première plage à remplir de la feuille "nombredetr"
End With
With Worksheets("nombredetr").Range("A1:H1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Worksheets("nombredetr").Range("A1:H1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
'..... chargement du code salarié dans un dictionnaire des codes avec pour clé nom + prénom
With Worksheets("détails")
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For i = 2 To dernière_ligne
clé = .Cells(i, "A").Value & " " & .Cells(i, "B").Value
If Not codes_salariés.Exists(clé) Then
codes_salariés.Add Key:=clé, Item:=.Cells(i, "C").Value
Else
MsgBox " nom + prénom en double " & clé
End If
Next i
End With
'..... traitement de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
Set xl = Application
dates = xl.Transpose(xl.Transpose(.Rows(4).Value)) 'tableau à une dimension des dates de la ligne 4 de la feuille référencée
j = 0 'intialisation indice de de la feuille "nombredetr"
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For i = 5 To dernière_ligne
'recherche premier congé payé dans la ligne i de la feuille référencée
Set CP1 = .Rows(i).Find("CP")
If Not CP1 Is Nothing Then
nom_prénom = .Cells(i, "A")
date_début = dates(CP1.Column)
If date_début = Empty Then date_début = dates(CP1.Column - 1) & " après-midi" _
Else date_début = date_début & " matin"
date_début_OK = True
'recherche congés payés après le premier dans la ligne i de la feuille référencée
Set CP = CP1
Do
If Not date_début_OK Then
date_début = dates(CP.Column)
If date_début = Empty Then date_début = dates(CP.Column - 1) & " après-midi" _
Else date_début = date_début & " matin"
date_début_OK = True
End If
date_fin = dates(CP.Column)
If date_fin = Empty Then date_fin = dates(CP.Column - 1) & " après-midi" _
Else date_fin = date_fin & " matin"
CP_col_prec = CP.Column
Set CP = .Rows(i).FindNext(CP) 'recherche CP suivant
If CP.Column <> CP_col_prec + 1 Then 'écriture ligne feuille "nombredetr" si période différente
GoSub ecr_ligne_nbtr
j = j + 1
date_début_OK = False
End If
Loop Until CP.Column = CP1.Column 'recherche jusqu'à n'il y ait plus de CP dans ligne i
End If
Next i
End With
Exit Sub
'..... sous-procédure de remplissage de la feuille "nombredetr"
ecr_ligne_nbtr:
nbtr_A2H2.Cells(, "A").Offset(j) = nom_prénom 'nom et prénom
nbtr_A2H2.Cells(, "B").Offset(j) = "vatcode" 'vatcode
nbtr_A2H2.Cells(, "C").Offset(j) = codes_salariés(nom_prénom) 'code salarié
nbtr_A2H2.Cells(, "D").Offset(j) = "'" & "330000" 'code rubrique CP"
nbtr_A2H2.Cells(, "E").Offset(j) = date_début 'date_début
nbtr_A2H2.Cells(, "F").Offset(j) = date_fin 'date_fin
Return
'..... fin sous-procédure de remplissage de la feuille "nombredetr"
End Sub
-
Bonjour ci-joint code modifié pour intégration plages début et fin
Sub Presentation()
'..... Déclaration variables
Dim dates() ' tableau des dates
Dim nbtr_A2H2 As Range ' plage A2:H2 de la feuille "nombredetr"
Dim codes_salariés As New Dictionary ' dictionnaire des codes salariés
Dim CP1 As Range, CP As Range
Dim nom_prénom As String, date_début As String, date_fin As String, plage_début As String, plage_fin As String
Dim CP_col_prec As Integer
Dim date_début_OK As Boolean
'..... initialisation de la feuille "nombredetr"
With Worksheets("nombredetr")
.Cells.Clear
.Columns("A:A").ColumnWidth = 25
.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Date de début"
.Range("F1").Value = "Date de Fin"
.Range("G1").Value = "Plage de début"
.Range("H1").Value = "Plage de Fin"
Set nbtr_A2H2 = .Range("A2:H2") 'première plage à remplir de la feuille "nombredetr"
End With
With Worksheets("nombredetr").Range("A1:H1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Worksheets("nombredetr").Range("A1:H1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
'..... chargement du code salarié dans un dictionnaire des codes avec pour clé nom + prénom
With Worksheets("détails")
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For i = 2 To dernière_ligne
clé = .Cells(i, "A").Value & " " & .Cells(i, "B").Value
If Not codes_salariés.Exists(clé) Then
codes_salariés.Add Key:=clé, Item:=.Cells(i, "C").Value
Else
MsgBox " nom + prénom en double " & clé
End If
Next i
End With
'..... traitement de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
Set xl = Application
dates = xl.Transpose(xl.Transpose(.Rows(4).Value)) 'tableau à une dimension des dates de la ligne 4 de la feuille référencée
j = 0 'intialisation indice de de la feuille "nombredetr"
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For i = 5 To dernière_ligne
'recherche premier congé payé dans la ligne i de la feuille référencée
Set CP1 = .Rows(i).Find("CP")
If Not CP1 Is Nothing Then
nom_prénom = .Cells(i, "A")
date_début = dates(CP1.Column)
plage_début = "journée"
If date_début = Empty Then
date_début = dates(CP1.Column - 1): If CP1.Offset(, -1) = Empty Then plage_début = "après-midi"
Else: If CP1.Offset(, 1) = Empty Then plage_début = "matinée"
End If
date_début_OK = True
'recherche congés payés après le premier dans la ligne i de la feuille référencée
Set CP = CP1
Do
If Not date_début_OK Then
date_début = dates(CP.Column)
plage_début = "journée"
If date_début = Empty Then
date_début = dates(CP.Column - 1): If CP.Offset(, -1) = Empty Then plage_début = "après-midi"
Else: If CP.Offset(, 1) = Empty Then plage_début = "matinée"
End If
date_début_OK = True
End If
date_fin = dates(CP.Column)
plage_fin = "journée"
If date_fin = Empty Then
date_fin = dates(CP.Column - 1): If CP.Offset(, -1) = Empty Then plage_fin = "après-midi"
Else: If CP.Offset(, 1) = Empty Then plage_fin = "matinée"
End If
CP_col_prec = CP.Column
Set CP = .Rows(i).FindNext(CP) 'recherche CP suivant
If CP.Column <> CP_col_prec + 1 Then 'écriture ligne feuille "nombredetr" si période différente
GoSub ecr_ligne_nbtr
j = j + 1
date_début_OK = False
End If
Loop Until CP.Column = CP1.Column 'recherche jusqu'à n'il y ait plus de CP dans ligne i
End If
Next i
End With
Exit Sub
'..... sous-procédure de remplissage de la feuille "nombredetr"
ecr_ligne_nbtr:
nbtr_A2H2.Cells(, "A").Offset(j) = nom_prénom 'nom et prénom
nbtr_A2H2.Cells(, "B").Offset(j) = "vatcode" 'vatcode
nbtr_A2H2.Cells(, "C").Offset(j) = "'" & codes_salariés(nom_prénom) 'code salarié
nbtr_A2H2.Cells(, "D").Offset(j) = "'" & "330000" 'code rubrique CP"
nbtr_A2H2.Cells(, "E").Offset(j) = date_début 'date_début
nbtr_A2H2.Cells(, "F").Offset(j) = date_fin 'date_fin
nbtr_A2H2.Cells(, "G").Offset(j) = plage_début 'plage_début
nbtr_A2H2.Cells(, "H").Offset(j) = plage_fin 'plage_fin
Return
'..... fin sous-procédure de remplissage de la feuille "nombredetr"
End Sub
-
Merci beaucoup ça marche parfaitement pour CP mais je dois rajouter les autres types de congés à mon tableau. J ai essayé de refaire la meme chose que vous mais il n y a rien qui change sur mon tableau
Deplus, est ce qu il y a moyen que mes codes rubriques et les libellés soient pris automatiquement de la feuille rubrique. j'ai pensé aux dictionnaires mais je vois pas encore comment
Voila le code que j ai "modifié"
Sub Presentation()
'..... Déclaration variables
Dim dates() ' tableau des dates
Dim nbtr_A2H2 As Range ' plage A2:H2 de la feuille "nombredetr"
Dim codes_salariés As New Dictionary ' dictionnaire des codes salariés
Dim CP1 As Range, CP As Range
Dim nom_prénom As String, date_début As String, date_fin As String, plage_début As String, plage_fin As String
Dim CP_col_prec As Integer
Dim date_début_OK As Boolean
'..... initialisation de la feuille "nombredetr"
With Worksheets("nombredetr")
.Cells.Clear
.Columns("A:A").ColumnWidth = 25
.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Libellé de la rubrique"
.Range("F1").Value = "Date de début"
.Range("G1").Value = "Date de Fin"
.Range("H1").Value = "Plage début absence"
.Range("I1").Value = "Plage fin absence"
.Range("J1").Value = "Valeur"
.Range("K1").Value = "Désactiver le calcul auto de l'indemnité"
.Range("L1").Value = "Hospitalisation"
.Range("M1").Value = "Nombre d'enfants"
.Range("N1").Value = "Prolongation"
.Range("O1").Value = "Date accident"
Set nbtr_A2H2 = .Range("A2:H2") 'première plage à remplir de la feuille "nombredetr"
End With
With Worksheets("nombredetr").Range("A1:O1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Worksheets("nombredetr").Range("A1:O1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
'..... chargement du code salarié dans un dictionnaire des codes avec pour clé nom + prénom
With Worksheets("détails")
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For I = 2 To dernière_ligne
clé = .Cells(I, "A").Value & " " & .Cells(I, "B").Value
If Not codes_salariés.Exists(clé) Then
codes_salariés.Add Key:=clé, Item:=.Cells(I, "C").Value
Else
MsgBox " nom + prénom en double " & clé
End If
Next I
End With
'..... traitement de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
Set xl = Application
dates = xl.Transpose(xl.Transpose(.Rows(4).Value)) 'tableau à une dimension des dates de la ligne 4 de la feuille référencée
J = 0 'intialisation indice de de la feuille "nombredetr"
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For I = 5 To dernière_ligne
'recherche premier congé payé dans la ligne i de la feuille référencée
Set CP1 = .Rows(I).Find("CP")
If Not CP1 Is Nothing Then
nom_prénom = .Cells(I, "A")
date_début = dates(CP1.Column)
plage_début = "jr"
If date_début = Empty Then
date_début = dates(CP1.Column - 1): If CP1.Offset(, -1) = Empty Then plage_début = "pm"
Else: If CP1.Offset(, 1) = Empty Then plage_début = "am"
End If
date_début_OK = True
'recherche congés payés après le premier dans la ligne i de la feuille référencée
Set CP = CP1
Do
If Not date_début_OK Then
date_début = dates(CP.Column)
plage_début = "jr"
If date_début = Empty Then
date_début = dates(CP.Column - 1): If CP.Offset(, -1) = Empty Then plage_début = "pm"
Else: If CP.Offset(, 1) = Empty Then plage_début = "am"
End If
date_début_OK = True
End If
date_fin = dates(CP.Column)
plage_fin = "jr"
If date_fin = Empty Then
date_fin = dates(CP.Column - 1): If CP.Offset(, -1) = Empty Then plage_fin = "pm"
Else: If CP.Offset(, 1) = Empty Then plage_fin = "am"
End If
CP_col_prec = CP.Column
Set CP = .Rows(I).FindNext(CP) 'recherche CP suivant
If CP.Column <> CP_col_prec + 1 Then 'écriture ligne feuille "nombredetr" si période différente
GoSub ecr_ligne_nbtr
J = J + 1
date_début_OK = False
End If
Loop Until CP.Column = CP1.Column 'recherche jusqu'à n'il y ait plus de CP dans ligne i
End If
Next I
End With
Exit Sub
'..... sous-procédure de remplissage de la feuille "nombredetr"
'..... traitement de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
Set xl = Application
dates = xl.Transpose(xl.Transpose(.Rows(4).Value)) 'tableau à une dimension des dates de la ligne 4 de la feuille référencée
J = 0 'intialisation indice de de la feuille "nombredetr"
With .UsedRange
dernière_ligne = .Row - 1 + .Rows.Count '1ère ligne plage utilisée - 1 + nombre de lignes utilisées
End With
For I = 5 To dernière_ligne
Set CP2 = .Rows(I).Find("M")
If Not CP2 Is Nothing Then
nom_prénom = .Cells(I, "A")
date_début = dates(CP2.Column)
plage_début = "jr"
If date_début = Empty Then
date_début = dates(CP2.Column - 1): If CP1.Offset(, -1) = Empty Then plage_début = "pm"
Else: If CP2.Offset(, 1) = Empty Then plage_début = "am"
End If
date_début_OK = True
'recherche congés payés après le premier dans la ligne i de la feuille référencée
Set CP = CP2
Do
If Not date_début_OK Then
date_début = dates(CP.Column)
plage_début = "jr"
If date_début = Empty Then
date_début = dates(CP.Column - 1): If CP.Offset(, -1) = Empty Then plage_début = "pm"
Else: If CP.Offset(, 1) = Empty Then plage_début = "matinée"
End If
date_début_OK = True
End If
date_fin = dates(CP.Column)
plage_fin = "jr"
If date_fin = Empty Then
date_fin = dates(CP.Column - 1): If CP.Offset(, -1) = Empty Then plage_fin = "pm"
Else: If CP.Offset(, 1) = Empty Then plage_fin = "am"
End If
CP_col_prec = CP.Column
Set CP = .Rows(I).FindNext(CP) 'recherche CP suivant
If CP.Column <> CP_col_prec + 1 Then 'écriture ligne feuille "nombredetr" si période différente
GoSub ecr_ligne_nbtr
J = J + 1
date_début_OK = False
End If
Loop Until CP.Column = CP2.Column 'recherche jusqu'à n'il y ait plus de CP dans ligne i
End If
Next I
End With
Exit Sub
'..... sous-procédure de remplissage de la feuille "nombredetr"
ecr_ligne_nbtr:
nbtr_A2H2.Cells(, "A").Offset(J) = nom_prénom 'nom et prénom
nbtr_A2H2.Cells(, "B").Offset(J) = "vatcode" 'vatcode
nbtr_A2H2.Cells(, "C").Offset(J) = "'" & codes_salariés(nom_prénom) 'code salarié
nbtr_A2H2.Cells(, "D").Offset(J) = "'" & "330000" 'code rubrique CP"
nbtr_A2H2.Cells(, "E").Offset(J) = "'" & "Jours d'absence congés payés"
nbtr_A2H2.Cells(, "F").Offset(J) = date_début 'date_début
nbtr_A2H2.Cells(, "G").Offset(J) = date_fin 'date_fin
nbtr_A2H2.Cells(, "H").Offset(J) = plage_début 'plage_début
nbtr_A2H2.Cells(, "I").Offset(J) = plage_fin 'plage_fin
Return
'..... fin sous-procédure de remplissage de la feuille "nombredetr"
Return
'..... fin sous-procédure de remplissage de la feuille "nombredetr"
End Sub
Sub ExportRangetoFile()
Dim Rng As Range
Dim WorkRng As Range
Dim xFile As Variant
Dim xFileString As String
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range("A1")
Set xFile = CreateObject("Scripting.FileSystemObject")
xFileString = Application.GetSaveAsFilename("", filefilter:="Comma Separated Text (*.CSV), *.CSV")
Application.ActiveWorkbook.SaveAs FileName:=xFileString, FileFormat:=xlCSV, CreateBackup:=False
End Sub
Et encore merci beaucoup- Bonjour,
Si la demande porte sur tous les types de congé, la recherche doit alors être faite sur le code de la couleur.
Pour pouvoir tester les bons codes couleurs, pouvez-vous me joindre dans un fichier Excel la ligne 2 de la feuille "Planning_conges.xls".
Pour ce qui concerne les rubriques de congé, le chargement dans un dictionnaire est possible à condition que les codes couleurs soient exactement les mêmes que ceux figurant dans la feuille "Planning_conges.xls" .
-
-
Bonsoir,
ci-dessous code permettant de gérer les couleurs de congé à partir de la ligne 2 de la feuille "Planning_conges.xls"
Sub Presentation()
'..... Déclaration variables
Dim dates() ' tableau des dates
Dim rubriques_congé As New Dictionary ' dictionnaire des rubriques de congé
Dim codes_salariés As New Dictionary ' dictionnaire des codes salariés
Dim nom_prénom As String, date_début As String, date_fin As String, plage_début As String, plage_fin As String
Dim c As Integer, colonne_congé As Integer, couleur_congé As Long, couleur_congé_prec As Long
Dim date_début_OK As Boolean
Dim i As Long, j As Long
Dim clé As Variant
Dim rubrique As Range, lib_rubrique As String
'..... initialisation de la feuille "nombredetr"
With Worksheets("nombredetr")
.Cells.Clear
.Columns("A:A").ColumnWidth = 25
.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Date de début"
.Range("F1").Value = "Date de Fin"
.Range("G1").Value = "Plage de début"
.Range("H1").Value = "Plage de Fin"
With .Range("A1:H1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("A1:H1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
End With
'..... chargement des rubriques congés dans un dictionnaire des rubriques avec pour clé le code couleur
'..... à partir de la ligne 2 de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
For Each rubrique In .Rows(2).SpecialCells(xlCellTypeConstants)
clé = rubrique.Offset(, -1).Interior.Color
If Not rubriques_congé.Exists(clé) Then
rubriques_congé.Add Key:=clé, Item:=rubrique
Else
MsgBox " couleur en double pour la rubrique " & rubrique
End If
Next rubrique
End With
'..... chargement du code salarié dans un dictionnaire des codes salariés avec pour clé nom + prénom
'..... à partir de la feuille "détails"
With Worksheets("détails")
With .UsedRange
dern_ligne = .Row + .Rows.Count - 1 '1ère ligne vide (= 1ère ligne utilisée + nombre lignes utilisées) - 1
End With
For i = 2 To dern_ligne
clé = .Cells(i, "A").Value & " " & .Cells(i, "B").Value
If Not codes_salariés.Exists(clé) Then
codes_salariés.Add Key:=clé, Item:=.Cells(i, "C").Value
Else
MsgBox " nom + prénom en double " & clé
End If
Next i
End With
'..... traitement de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
Set xl = Application
dates = xl.Transpose(xl.Transpose(.Rows(4).Value)) 'tableau à une dimension des dates de la ligne 4 de la feuille référencée
j = 2 'intialisation indice de de la feuille "nombredetr"
With .UsedRange
dern_ligne = .Row + .Rows.Count - 1 '1ère ligne vide (= 1ère ligne utilisée + nombre lignes utilisées) - 1
dern_colonne = .Column + .Columns.Count - 1 '1ère colonne vide (= 1ère colonne utilisée + nombre colonnes utilisées) - 1
End With
For i = 5 To dern_ligne
nom_prénom = .Cells(i, "A")
'recherche code couleur dans la ligne i de la feuille référencée
date_début_OK = False
colonne_congé = 2
couleur_congé = 0
For c = 2 To dern_colonne
clé = .Cells(i, c).Interior.Color
If rubriques_congé.Exists(clé) Then
couleur_congé = clé
colonne_congé = c
'écriture ligne feuille "nombredetr" si couleur différente
If date_début_OK Then
If couleur_congé <> couleur_congé_prec Then
lib_rubrique = rubriques_congé(couleur_congé_prec)
GoSub ecr_ligne_nbtr 'écriture ligne feuille "nombredetr"
j = j + 1 'incrémentation indice de de la feuille "nombredetr"
date_début_OK = False
End If
End If
'initialisation de la date début
If Not date_début_OK Then
couleur_congé_prec = couleur_congé
date_début = dates(c)
plage_début = "jr"
If date_début = Empty Then
date_début = dates(c - 1): If .Cells(i, c - 1).Interior.Color <> couleur_congé Then plage_début = "pm"
Else: If .Cells(i, c + 1).Interior.Color <> couleur_congé Then plage_début = "am"
End If
date_début_OK = True
End If
'remplissage de la date fin
date_fin = dates(c)
plage_fin = "jr"
If date_fin = Empty Then
date_fin = dates(c - 1): If .Cells(i, c - 1).Interior.Color <> couleur_congé Then plage_fin = "pm"
Else: If .Cells(i, c + 1).Interior.Color <> couleur_congé Then plage_fin = "am"
End If
End If
'écriture ligne feuille "nombredetr" si période différente ou dernière colonne traitée
If c <> colonne_congé _
Or c = dern_colonne Then
If date_début_OK Then
lib_rubrique = rubriques_congé(couleur_congé)
GoSub ecr_ligne_nbtr 'écriture ligne feuille "nombredetr"
j = j + 1 'incrémentation indice de de la feuille "nombredetr"
date_début_OK = False
End If
End If
Next c
Next i
End With
Exit Sub
'..... sous-procédure de remplissage de la feuille "nombredetr"
ecr_ligne_nbtr:
With Worksheets("nombredetr")
.Cells(j, "A") = nom_prénom 'nom et prénom
.Cells(j, "B") = "vatcode" 'vatcode
.Cells(j, "C") = "'" & codes_salariés(nom_prénom) 'code salarié
.Cells(j, "D") = lib_rubrique 'rubrique congé
.Cells(j, "E") = date_début 'date_début
.Cells(j, "F") = date_fin 'date_fin
.Cells(j, "G") = plage_début 'plage_début
.Cells(j, "H") = plage_fin 'plage_fin
End With
Return
'..... fin sous-procédure de remplissage de la feuille "nombredetr"
End Sub
-
Merci thev
Oui ça m'affiche tout les types de congés. J ai encore 2 soucis
Je me suis peut etre mal exprimée mais le code rubrique et le libelle de la rubrique doivent venir de la feuille rubrique Donc sur mon tableau je dois avoir les codes de la feuille liste_rubrique et le libellé qui va avec qui est ausssi sur la meme feuille dans la colonne B.
Le 2eme c est au niveau de la date de début; je sais pas pourquoi ça me sort le mot "département " dans la colonne date de début
Je mettrai des captures d ecran
MERCI INFINIMENT
-
-
Bonsoir,
Pour le premier souci, il suffit de modifier le chargement du dictionnaire des rubriques à partir de la feuille rubrique,
en supposant que les codes couleur correspondent à ceux du planning et qu'ils se trouvent dans la colonne F de la feuille rubrique.
ci-dessous nouveau code
Sub Presentation()
'..... Déclaration variables
Dim dates() ' tableau des dates
Dim rubriques_congé As New Dictionary ' dictionnaire des rubriques de congé
Dim codes_salariés As New Dictionary ' dictionnaire des codes salariés
Dim nom_prénom As String, date_début As String, date_fin As String, plage_début As String, plage_fin As String
Dim c As Integer, colonne_congé As Integer, couleur_congé As Long, couleur_congé_prec As Long
Dim date_début_OK As Boolean
Dim i As Long, j As Long
Dim clé As Variant
Dim rubrique As Range, id_rubrique As String, tab_rubrique() As String, cod_rubrique As String, lib_rubrique As String
'..... initialisation de la feuille "nombredetr"
With Worksheets("nombredetr")
.Cells.Clear
.Columns("A:A").ColumnWidth = 25
.Range("A1").Value = "Nom et Prénom"
.Range("B1").Value = "Code VAT System"
.Range("C1").Value = "Code Salarié"
.Range("D1").Value = "Code Rubrique"
.Range("E1").Value = "Libellé Rubrique"
.Range("F1").Value = "Date de début"
.Range("G1").Value = "Date de Fin"
.Range("H1").Value = "Plage de début"
.Range("I1").Value = "Plage de Fin"
With .Range("A1:H1").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 6299648
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Range("A1:H1").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
' .HorizontalAlignment = xlCenter
' .Borders.Weight = xlThin
End With
End With
'..... chargement des rubriques congés dans un dictionnaire des rubriques avec pour clé le code couleur
'..... à partir de la feuille "rubrique"
With Worksheets("rubrique")
For Each rubrique In .Columns("F").SpecialCells(xlCellTypeConstants)
clé = rubrique.Interior.Color
If Not rubriques_congé.Exists(clé) Then
'code et libellé rubriques décalés de 4 et 3 colonnes en arrière de la couleur
rubriques_congé.Add Key:=clé, Item:=rubrique.Offset(, -4) & "/" & rubrique.Offset(, -3)
Else
MsgBox " couleur en double pour la rubrique " & rubrique
End If
Next rubrique
End With
'..... chargement du code salarié dans un dictionnaire des codes salariés avec pour clé nom + prénom
'..... à partir de la feuille "détails"
With Worksheets("détails")
With .UsedRange
dern_ligne = .Row + .Rows.Count - 1 '1ère ligne vide (= 1ère ligne utilisée + nombre lignes utilisées) - 1
End With
For i = 2 To dern_ligne
clé = .Cells(i, "A").Value & " " & .Cells(i, "B").Value
If Not codes_salariés.Exists(clé) Then
codes_salariés.Add Key:=clé, Item:=.Cells(i, "C").Value
Else
MsgBox " nom + prénom en double " & clé
End If
Next i
End With
'..... traitement de la feuille "Planning_conges.xls"
With Worksheets("Planning_conges.xls")
Set xl = Application
dates = xl.Transpose(xl.Transpose(.Rows(4).Value)) 'tableau à une dimension des dates de la ligne 4 de la feuille référencée
j = 2 'intialisation indice de de la feuille "nombredetr"
With .UsedRange
dern_ligne = .Row + .Rows.Count - 1 '1ère ligne vide (= 1ère ligne utilisée + nombre lignes utilisées) - 1
dern_colonne = .Column + .Columns.Count - 1 '1ère colonne vide (= 1ère colonne utilisée + nombre colonnes utilisées) - 1
End With
For i = 5 To dern_ligne
nom_prénom = .Cells(i, "A")
'recherche code couleur dans la ligne i de la feuille référencée
date_début_OK = False
colonne_congé = 2
couleur_congé = 0
For c = 2 To dern_colonne
clé = .Cells(i, c).Interior.Color
If rubriques_congé.Exists(clé) Then
couleur_congé = clé
colonne_congé = c
'écriture ligne feuille "nombredetr" si couleur différente
If date_début_OK Then
If couleur_congé <> couleur_congé_prec Then
id_rubrique = rubriques_congé(couleur_congé_prec)
GoSub ecr_ligne_nbtr 'écriture ligne feuille "nombredetr"
j = j + 1 'incrémentation indice de de la feuille "nombredetr"
date_début_OK = False
End If
End If
'initialisation de la date début
If Not date_début_OK Then
couleur_congé_prec = couleur_congé
date_début = dates(c)
plage_début = "jr"
If date_début = Empty Then
date_début = dates(c - 1): If .Cells(i, c - 1).Interior.Color <> couleur_congé Then plage_début = "pm"
Else: If .Cells(i, c + 1).Interior.Color <> couleur_congé Then plage_début = "am"
End If
date_début_OK = True
End If
'remplissage de la date fin
date_fin = dates(c)
plage_fin = "jr"
If date_fin = Empty Then
date_fin = dates(c - 1): If .Cells(i, c - 1).Interior.Color <> couleur_congé Then plage_fin = "pm"
Else: If .Cells(i, c + 1).Interior.Color <> couleur_congé Then plage_fin = "am"
End If
End If
'écriture ligne feuille "nombredetr" si période différente ou dernière colonne traitée
If c <> colonne_congé _
Or c = dern_colonne Then
If date_début_OK Then
id_rubrique = rubriques_congé(couleur_congé)
GoSub ecr_ligne_nbtr 'écriture ligne feuille "nombredetr"
j = j + 1 'incrémentation indice de de la feuille "nombredetr"
date_début_OK = False
End If
End If
Next c
Next i
End With
Exit Sub
'..... sous-procédure de remplissage de la feuille "nombredetr"
ecr_ligne_nbtr:
tab_rubrique = Split(id_rubrique, "/")
cod_rubrique = tab_rubrique(0)
lib_rubrique = tab_rubrique(1)
With Worksheets("nombredetr")
.Cells(j, "A") = nom_prénom 'nom et prénom
.Cells(j, "B") = "vatcode" 'vatcode
.Cells(j, "C") = "'" & codes_salariés(nom_prénom) 'code salarié
.Cells(j, "D") = "'" & cod_rubrique 'code rubrique congé
.Cells(j, "E") = lib_rubrique 'libellé rubrique congé
.Cells(j, "F") = date_début 'date_début
.Cells(j, "G") = date_fin 'date_fin
.Cells(j, "H") = plage_début 'plage_début
.Cells(j, "I") = plage_fin 'plage_fin
End With
Return
'..... fin sous-procédure de remplissage de la feuille "nombredetr"
End Sub
Pour le 2ème souci, il faudrait voir ce qui se trouve dans les colonnes B et C de la feuille ""Planning_conges.xls". -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
En fait pour le 2ème souci,
1- contrôler que le dictionnaire des rubriques ne contient pas de couleur blanche et donc modifier le code ci-dessus comme suit :
'..... chargement des rubriques congés dans un dictionnaire des rubriques avec pour clé le code couleur
'..... à partir de la feuille "rubrique"
With Worksheets("rubrique")
For Each rubrique In .Columns("F").SpecialCells(xlCellTypeConstants)
clé = rubrique.Interior.Color
If clé <> "16777215" Then 'pas de couleur blanche
If Not rubriques_congé.Exists(clé) Then
'code et libellé rubriques décalés de 4 et 3 colonnes en arrière de la couleur
rubriques_congé.Add Key:=clé, Item:=rubrique.Offset(, -4) & "/" & rubrique.Offset(, -3)
Else
MsgBox " couleur en double pour la rubrique " & rubrique
End If
End If
Next rubrique
End With
2- commencer la recherche des couleurs en colonne D et donc modifier le code ci-dessus comme suitFor c = 4 To dern_colonne
-
Bonjour,
Je vous proposerai une réponse d'ici demain. Pouvez-vous me confirmer que les dates se trouvent en colonnes D, F, H, J, ... ?
-
Voici le capture d ecran ou j ai departement
J ai cherché dans le code ou est ce qu il peut y avoir le probleme mais j ai pas reussi a trouver
Voici tableau que j aimerais avoir. c est le resultat que j avais avec seulement les congés payés
Pour la feuille planning conges et la feuille rubrique je sais qu'il y a un peu incomptaibilité au niveau des codes mais ca va se regler
Merci beaucouuuuuup -
Je reviens à cette discussion j aurai besoin de changer un ptit detail.
En fait je veux recuperer les codes par les noms que j'ai sur le fichier plutot que les couleurs j ai changé .Font.Color par .value dans le code mais ça me sort plus rien.
Est ce que tu pourrras stp m'aider ou me dir epourquoi quand je change à .Value ça marche et qu est ce que je dois changer
Merco et desolee d etre revenue vers toi encore une fois -
Le mieux serait que tu me communiques un fichier avec le code modifié car je suppose que la feuille planning a évolué.
-
-
Desolee pour le retard et merci bcp pr ta reponse mais ils me donnent message d erreur pr le code
le message est compile error. Incalid use of new keyword
et c est sur cette ligne qui est dans la 1ere partie des déclarations
Dim rubriques_conge As New Dictionary ' dictionnaire des rubriques de congé
-
-
2 solutions :
1- soit ajouter dans l'éditeur VBA la référence "Microsoft Scripting Runtime'"
2- soit modifier
par
Dim rubriques_congé As New Dictionary ' dictionnaire des rubriques de congé
Dim codes_salariés As New Dictionary ' dictionnaire des codes salariés
Set rubriques_congé = CreateObject("Scripting.Dictionary") ' dictionnaire des rubriques de congé
Set codes_salariés = CreateObject("Scripting.Dictionary") ' dictionnaire des codes salariés-
J'ai opté pour la 2eme solution parce que je travaille mnt sur un mac et j arrive pas a ajouter la reference.
Quand j ai changé le code j ai mnt erreur: compile error: Method or Data member not found sur la ligne 3 de clé=rubrique.Value
With Worksheets("rubrique")
For Each rubrique In .Columns("E").SpecialCells(xlCellTypeConstants)
clé = rubrique.Value -
-
-
As_tu essayé
Dim rubrique As Variant
?
A quelle ligne se produit l'erreur ? -
https://www.cjoint.com/c/FInwCudIqTc
Voici le lien du le fichier avec les modifications que vous m'avez dit comme ça vous pourrez voir l'erreur -
Le problème est que sous Mac, la bibliothèque contenant l'objet "Scripting.Dictionary" n'est pas disponible.
Il faut donc revoir le code en utilisant l'objet "Collection" qui est standard pour toutes les versions de Microsoft Office. Je vous communique donc une nouvelle version d'ici demain. -
ci-joint nouvelle version avec l'objet "Collection" en lieu et place de l'objet "Scripting.Dictionary"
https://www.cjoint.com/c/FIolvs453Eq
-
ouiiii c est exactemet ce que je devais avoir :) :) :)
Meerci beaucoup.
Derniere chose: Je veux que le tableau soit importé en fichier csv avec tous les champs separés par des ;
j ai fait ce code mais ca marche sur mon mac mais pas sur les autres ordis.Est ce que t as une idee sur ça
Voila le code
Sub SaveAsCSV()
'steve, mpfe
Dim Range As Object, Line As Object, Cell As Object
Dim StrTemp As String
Dim Separateur As String
Separateur = ";"
Set Range = ActiveSheet.UsedRange
Open "Test.csv" For Output As #1
For Each Line In Range.Rows
StrTemp = ""
For Each Cell In Line.Cells
StrTemp = StrTemp & CStr(Cell.Text) & Separateur
Next
Print #1, StrTemp '= " "
Next
Close
End Sub
Et merci encore et encore et encore et encore beaucouuuuuuuuup
-
