L'indice n'appartient pas a la selection
n
Bonjour,
bon, je vais au debut expliquer ce que je dois faire:
j'ai un classeur ou il y'a deux feuilles:
-planning absence:
qui contient un calendrier pour chaque mois, ou pour chaque mois, y'a les colonnes svtes:
A de G à AK
liste des ressources les jours du mois
ou pour chaque jour on note la periode d'absence (0.1-->1)
-liste des ressources et activités:
A C
listes des ressources congés initiaux
dans congés initiaux est incrementale, chaque qu'il y'a une absence pour cause de formation ou de maladie, on ajoute cette charge a la valeur deja existante dans cette colonne pour la ressource concernée.
apres dans un autre emplacement, j'ai un repertoire (RMA) ou il y'a plusieurs classeurs (un classeur pour chaque ressource), chacun des ces classeurs contient une feuille excel:
voila comment il est:
B C de D à AH
Type d'absence total absence les jours du mois
ou chaque jour s'il y'a absence on note la durée (0.1 --> 1)
j'ai fais le code suivant:
Sub planning()
'-----------------------------------------------------------------------------------------
' Déclarations
'-----------------------------------------------------------------------------------------
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim Nchaine As String, Ndebut As String, Nfin As String
Dim Mchaine As String, Mdebut As String, f1mois As String
Dim name As String, namechemin As String
Dim Repertoire As String
Dim fPnom As String, fPnom1 As String, f1nom As String
Dim DerLig1 As Long, Lig1 As Long
Dim LigBo As Long, DerCel As Long, DerCel1 As Long
Dim listeRH As Worksheet
'-----------------------------------------------------------------------------------------
' Traitements
'-----------------------------------------------------------------------------------------
Repertoire = Worksheets("Plannings Absences").Range("AP" & 518).Value
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
name = FileItem.name
namechemin = Repertoire & FileItem.name
'fnom renvoie le nom extrait du nom de fichier
Nchaine = FileItem.name
Ndebut = InStr(1, Nchaine, " ", vbTextCompare) + 1
Nfin = InStr(1, Nchaine, "_", vbTextCompare)
f1nom = Mid(Nchaine, Ndebut, Nfin - Ndebut)
'fmois renvoie le mois extrait du nom du fichier
Mchaine = FileItem.name
Mdebut = Right(Mchaine, 9)
f1mois = Mid(Mdebut, 1, 2)
'rendre les mois en nombre en alphabet
If f1mois = "10" Then
f1mois = "Octobre"
End If
With Sheets("Plannings Absences")
For Lig1 = 517 To 553
'fPnom renvois le nom dans la feuille planning
Pchaine = .Range("A" & Lig1).Value
Pdebut = InStr(1, Pchaine, " ", vbTextCompare)
fPnom1 = Mid(Pchaine, 1, Pdebut)
fPnom = Replace(fPnom1, " ", "")
'Workbooks.Open (namechemin)
If f1nom = fPnom Then
Workbooks.Open (namechemin)
'tester sur la formation (Trainning)
colT = 3
col2T = 7
LigRH = 16
If Workbooks(name).Worksheets("feuil1").Cells(14, colT).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(14, colT).Value <> "" Then
For col1T = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(14, col1T).Value <> "" Then
.Cells(Lig1, col2T).Value = Workbooks(name).Worksheets("feuil1").Cells(14, col1T).Value
[color=red]Set listeRH = Sheets("Liste des ressources & Activité")
listeRH.Cells(LigRH, 3).Value = (listeRH.Cells(LigRH, 3).Value) + (Workbooks(name).Worksheets("feuil1").Cells(14, col1T).Value)[/color]
col2T = col2T + 1
LigRH = LigRH + 1
Else
col2T = col2T + 1
LigRH = LigRH + 1
End If
Next col1T
Else
End If
'tester sur technique
colTech = 3
col2Tech = 7
If Workbooks(name).Worksheets("feuil1").Cells(15, colTech).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(15, colTech).Value <> "" Then
For col1Tech = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(15, col1Tech).Value <> "" Then
.Cells(Lig1, col2Tech).Value = Workbooks(name).Worksheets("feuil1").Cells(15, col1Tech).Value
col2Tech = col2Tech + 1
Else
col2Tech = col2Tech + 1
End If
Next col1Tech
Else
End If
'tester sur CMMI
colCMMI = 3
col2CMMI = 7
If Workbooks(name).Worksheets("feuil1").Cells(16, colCMMI).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(16, colCMMI).Value <> "" Then
For col1CMMI = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(16, col1CMMI).Value <> "" Then
.Cells(Lig1, col2CMMI).Value = Workbooks(name).Worksheets("feuil1").Cells(16, col1CMMI).Value
col2CMMI = col2CMMI + 1
Else
col2CMMI = col2CMMI + 1
End If
Next col1CMMI
Else
End If
'tester sur Secretariat
colS = 3
col2S = 7
If Workbooks(name).Worksheets("feuil1").Cells(17, colS).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(17, colS).Value <> "" Then
For col1S = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(17, col1S).Value <> "" Then
.Cells(Lig1, col2S).Value = Workbooks(name).Worksheets("feuil1").Cells(17, col1S).Value
col2S = col2S + 1
Else
col2S = col2S + 1
End If
Next col1S
Else
End If
'tester sur Gestion
colG = 3
col2G = 7
If Workbooks(name).Worksheets("feuil1").Cells(18, colG).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(18, colG).Value <> "" Then
For col1G = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(18, col1G).Value <> "" Then
.Cells(Lig1, col2G).Value = Workbooks(name).Worksheets("feuil1").Cells(18, col1G).Value
col2G = col2G + 1
Else
col2G = col2G + 1
End If
Next col1G
Else
End If
'tester sur RH
colRH = 3
col2RH = 7
If Workbooks(name).Worksheets("feuil1").Cells(19, colRH).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(19, colRH).Value <> "" Then
For col1RH = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(19, col1RH).Value <> "" Then
.Cells(Lig1, col2RH).Value = Workbooks(name).Worksheets("feuil1").Cells(19, col1RH).Value
col2RH = col2RH + 1
Else
col2RH = col2RH + 1
End If
Next col1RH
Else
End If
'tester sur GSD
colGSD = 3
col2GSD = 7
If Workbooks(name).Worksheets("feuil1").Cells(20, colGSD).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(20, colGSD).Value <> "" Then
For col1GSD = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(20, col1GSD).Value <> "" Then
.Cells(Lig1, col2GSD).Value = Workbooks(name).Worksheets("feuil1").Cells(20, col1GSD).Value
col2GSD = col2GSD + 1
Else
col2GSD = col2GSD + 1
End If
Next col1GSD
Else
End If
'tester sur Stage
colSTG = 3
col2STG = 7
If Workbooks(name).Worksheets("feuil1").Cells(21, colSTG).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(21, colSTG).Value <> "" Then
For col1STG = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(21, col1STG).Value <> "" Then
.Cells(Lig1, col2STG).Value = Workbooks(name).Worksheets("feuil1").Cells(21, col1STG).Value
col2STG = col2STG + 1
Else
col2STG = col2STG + 1
End If
Next col1STG
Else
End If
'tester sur Recrutement
colR = 3
col2R = 7
If Workbooks(name).Worksheets("feuil1").Cells(22, colR).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(22, colR).Value <> "" Then
For col1R = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(22, col1R).Value <> "" Then
.Cells(Lig1, col2R).Value = Workbooks(name).Worksheets("feuil1").Cells(22, col1R).Value
col2R = col2R + 1
Else
col2R = col2R + 1
End If
Next col1R
Else
End If
'tester sur Business
colB = 3
col2B = 7
If Workbooks(name).Worksheets("feuil1").Cells(23, colB).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(23, colB).Value <> "" Then
For col1B = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(23, col1B).Value <> "" Then
.Cells(Lig1, col2B).Value = Workbooks(name).Worksheets("feuil1").Cells(23, col1B).Value
col2B = col2B + 1
Else
col2B = col2B + 1
End If
Next col1B
Else
End If
'tester sur Congé Payé
colCP = 3
col2CP = 7
If Workbooks(name).Worksheets("feuil1").Cells(24, colCP).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(24, colCP).Value <> "" Then
For col1CP = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(24, col1CP).Value <> "" Then
.Cells(Lig1, col2CP).Value = Workbooks(name).Worksheets("feuil1").Cells(24, col1CP).Value
col2CP = col2CP + 1
Else
col2CP = col2CP + 1
End If
Next col1CP
Else
End If
'tester sur Congé Non Payé
colCNP = 3
col2CNP = 7
If Workbooks(name).Worksheets("feuil1").Cells(25, colCNP).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(25, colCNP).Value <> "" Then
For col1CNP = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(25, col1CNP).Value <> "" Then
.Cells(Lig1, col2CNP).Value = Workbooks(name).Worksheets("feuil1").Cells(25, col1CNP).Value
col2CNP = col2CNP + 1
Else
col2CNP = col2CNP + 1
End If
Next col1CNP
Else
End If
'tester sur Congé Exceptionnel
colCE = 3
col2CE = 7
If Workbooks(name).Worksheets("feuil1").Cells(26, colCE).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(26, colCE).Value <> "" Then
For col1CE = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(26, col1CE).Value <> "" Then
.Cells(Lig1, col2CE).Value = Workbooks(name).Worksheets("feuil1").Cells(26, col1CE).Value
col2CE = col2CE + 1
Else
col2CE = col2CE + 1
End If
Next col1CE
Else
End If
'tester sur Congé de Matérnité
colCM = 3
col2CM = 7
If Workbooks(name).Worksheets("feuil1").Cells(27, colCM).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(27, colCM).Value <> "" Then
For col1CM = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(27, col1CM).Value <> "" Then
.Cells(Lig1, col2CM).Value = Workbooks(name).Worksheets("feuil1").Cells(27, col1CM).Value
col2CM = col2CM + 1
Else
col2CM = col2CM + 1
End If
Next col1CM
Else
End If
'tester sur la maladie
colMa = 3
col2Ma = 7
If Workbooks(name).Worksheets("feuil1").Cells(28, colMa).Value <> "0" And Workbooks(name).Worksheets("feuil1").Cells(28, colMa).Value <> "" Then
For col1Ma = 4 To 34
If Workbooks(name).Worksheets("feuil1").Cells(28, col1Ma).Value <> "" Then
.Cells(Lig1, col2Ma).Value = Workbooks(name).Worksheets("feuil1").Cells(28, col1Ma).Value
col2Ma = col2Ma + 1
Else
col2Ma = col2Ma + 1
End If
Next col1Ma
Else
End If
Workbooks(name).Close SaveChanges:=False
End If
Next Lig1
End With
Next FileItem
End Suble probleme c quand j'ajoute la ligne en rouge, qui sert a incrementer les congés initiaux dans la feuille "listes des ressources" dans le cas de formation et maladie, j'ai ll'erreur suivante (l'indice n'appartient pas à la selection), est ce que vous pouvez me dire c'est du a quoi?
Merci a vous
n
bon , pour ceux qui ont le meme probleme, la solution est de faire sortir le set en dehors du for et du with
merci a ceux qui ont pensé a mon probleme