many62
-
Modifié par jordane45 le 19/10/2016 à 12:09
f894009
Messages postés17206Date d'inscriptiondimanche 25 novembre 2007StatutMembreDernière intervention22 novembre 2024
-
19 oct. 2016 à 13:52
Bonjour,
J'ai crée ma macro avec la version 2003 d'excel, pourtant elle fonction très bien sur la version 2013. lorsque je l'utilise à mon entreprise avec excel 2010.
J'ai tout d'abord l'erreur 32809, puis l'erreur 1004.
pourtant je n'ai rien changé à la macro.
pouvez m'aider svp
Voici mon code:
Sub synthèse_absence()
' synthèse_absence Macro
'declaration des variables
Dim nom_macro, fichier_abs, fichier_creditdebit, fichier_ECR_HPP As String
Dim fichier_resultat, categorie As String
Dim chemin_abs, chemin_creditdebit, chemin_ECR_HPP, chemin_resultat As String
Dim personnel, annee_new, annee_old, annee, repertoire_abs As String
Dim creditdebit, ecretage, HPP As Date
Dim boucle_abs, boucle_debcred, boucle_ECRHPP, boucle_fichier_resu As Integer
Dim boucle_personnel, ligne_resultat As Integer
Dim nombre_de_feuilles As Integer
Dim recopie As Boolean
Dim increment, boucle_categorie, numero_passage As Integer
Dim nom_onglet(5) As String
Dim abs_categorie, abs_totale, departement As String
'******************************************************************************
'************** INITIALISATION ************************************************
'******************************************************************************
'definition des noms des onglets des fichiers resultat
nom_onglet(1) = "tx abs santé"
nom_onglet(2) = "Ecrêtage"
nom_onglet(3) = "HPP"
nom_onglet(4) = "Crédit Débit"
nom_onglet(5) = "temporaire"
'definition de l'onglet utile des fichiers mensuels d'absenteisme
repertoire_abs = "Taux ABS"
nom_macro = ActiveWorkbook.Name
'MsgBox (nom_macro)
'recuperation de l'info de l'année (exemple "2016") d'après le contenu de E2 :
'"CREDIT DEBIT nn2016.xls" pour mettre à jour les intitulés des onglets resultat
ActiveWorkbook.Sheets("macro").Activate
annee_new = Mid(Range("E2"), 16, 4)
'MsgBox ("annee new : " + annee_new)
'recuperation de l'info de l'année dans les onglets type pour pouvoir ensuite
'remplacer cette info : "Absentéisme 2017"
ActiveWorkbook.Sheets(nom_onglet(1)).Activate
annee_old = Mid(Range("A1"), 13, 4)
'MsgBox ("annee old : " + annee_old)
'certains onglets de cette macro ne sont pas affichés
Workbooks(nom_macro).Activate
For increment = 1 To 5
ActiveWorkbook.Sheets(nom_onglet(increment)).Activate
ActiveWorkbook.Sheets(nom_onglet(increment)).Visible = True
Cells.Replace What:=annee_old, Replacement:=annee_new, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
'modif : on laisse les onglets macro visible !!
ActiveWorkbook.Sheets(nom_onglet(increment)).Visible = True
Next increment
'éviter les mises à jour d'écran
Application.ScreenUpdating = False
'pas d 'objection si le fichier existe déjà !(voir +loin)
Application.DisplayAlerts = False
ActiveWorkbook.Sheets("macro").Select
'on memorise la forme des fichiers de données
'il faudra juste mettre le numero du mois dans le nom du fichier au bon endroit
fichier_creditdebit = Cells(2, 5).Formula
'MsgBox (fichier_creditdebit)
fichier_ECR_HPP = Cells(4, 5).Formula
'MsgBox (fichier_ECR_HPP)
fichier_abs = Cells(6, 5).Formula
'MsgBox (fichier_abs)
'on memorise le nombre de feuilles dans un nouveau classeur excell pour
'remettre ce nombre dans la configuration de Excell à la fin de cette macro
'on modifie temporairement le nombre de feuilles excell d'un nouveau classeur : 4 feuilles
'MsgBox (Application.SheetsInNewWorkbook)
nombre_de_feuilles = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 4
'******************************************************************************
'************** VERIFICATION **************************************************
'******************************************************************************
'verification de l'existence des repertoires declares : chemin_abs
chemin_abs = Cells(5, 5).Formula
If (Dir(chemin_abs, vbDirectory) = "") Then
MsgBox (chemin_abs + " n'existe pas : a vous de le creer !")
Exit Sub
ElseIf (Right(chemin_abs, 1) <> "\") Then
chemin_abs = chemin_abs + "\"
End If
'MsgBox (chemin_abs)
'verification de l'existence des repertoires declares : chemin_creditdebit
chemin_creditdebit = Cells(1, 5).Formula
If (Dir(chemin_creditdebit, vbDirectory) = "") Then
MsgBox (chemin_creditdebit + " n'existe pas : a vous de le creer !")
Exit Sub
ElseIf (Right(chemin_creditdebit, 1) <> "\") Then
chemin_creditdebit = chemin_creditdebit + "\"
End If
'MsgBox (chemin_creditdebit)
'verification de l'existence des repertoires declares : chemin_ECR_HPP
chemin_ECR_HPP = Cells(3, 5).Formula
If (Dir(chemin_ECR_HPP, vbDirectory) = "") Then
MsgBox (chemin_ECR_HPP + " n'existe pas : a vous de le creer !")
Exit Sub
ElseIf (Right(chemin_ECR_HPP, 1) <> "\") Then
chemin_ECR_HPP = chemin_ECR_HPP + "\"
End If
'MsgBox (chemin_ECR_HPP)
'verification de l'existence des repertoires declares : chemin_resultat
chemin_resultat = Cells(7, 5).Formula
If (Dir(chemin_resultat, vbDirectory) = "") Then
MsgBox (chemin_resultat + " n'existe pas : a vous de le creer !")
Exit Sub
ElseIf (Right(chemin_resultat, 1) <> "\") Then
chemin_resultat = chemin_resultat + "\"
End If
'MsgBox (chemin_resultat)
'parametres de la macro
'verification : l'année indiquée dans le nom des 3 fichiers doit être la même !
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("macro").Activate
annee = Mid(Cells(2, 5).Value, 16, 4)
'MsgBox (annee)
If (annee <> Mid(Cells(4, 5).Value, 11, 4) Or annee <> Mid(Cells(6, 5).Value, 7, 4)) Then
MsgBox ("Erreur dans les années indiquées en E2, E4, E6 : ce ne sont pas les mêmes !")
Exit Sub
End If
'******************************************************************************
'******************************************************************************
'boucle sur les categories et les fichiers resultats à constituer
'******************************************************************************
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("macro").Activate
boucle_fichier_resu = 1
numero_passage = 0 'pour memoriser a chaque fichier resu, le departement des personnels
'boucle sur la liste des categories et des fichiers resultat à creer
'le premier fichier resu est ligne2, colonne2
Do While Cells(1 + boucle_fichier_resu, 2).Formula <> ""
fichier_resultat = Cells(1 + boucle_fichier_resu, 2).Formula
If (fichier_resultat <> "RIEN") Then
'pour detecter le premier passage et pouvoir noter le departement de chaque personnel
'dans l'onglet temporaire de la macro
'on ne peut pas utiliser "boucle_fichier_resu" car il peut y avoir "RIEN" dans les
'premières lignes de la macro (colonne B)
numero_passage = numero_passage + 1
'recuperation de l'intitulé de la catégorie à partir des paramètres de la macro
categorie = Cells(1 + boucle_fichier_resu, 1).Formula
'MsgBox ("categorie traitée : " + categorie)
'creation du fichier resultat
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=chemin_resultat + fichier_resultat, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'nommer les quatre feuilles du fichier et les initialiser
'a partir des feuilles pre-remplies de la macro
For increment = 1 To 4
Workbooks(fichier_resultat).Sheets(increment).Name = nom_onglet(increment)
'pre-remplir le fichier resultat
Workbooks(nom_macro).Sheets(nom_onglet(increment)).Activate
Cells.Select
Selection.Copy
Workbooks(fichier_resultat).Sheets(nom_onglet(increment)).Activate
Cells.Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Next increment
'************************************************************************************
'******************************* absenteisme ****************************************
'************************************************************************************
'mettre le titre de la categorie dans l'onglet resultat
Workbooks(fichier_resultat).Activate
ActiveWorkbook.Sheets(nom_onglet(1)).Activate
Range("A6").Formula = categorie
'boucle sur les fichiers d'absenteisme des mois de l'année
'il n'y en a pas forcément 12 !!
boucle_abs = 1
Do While boucle_abs < 13
'reconstituer le nom du fichier absenteisme
Mid(fichier_abs, 5, 2) = CStr(Format(boucle_abs, "00"))
'MsgBox (fichier_abs)
If Dir(chemin_abs + fichier_abs) = "" Then
'MsgBox (fichier_abs + " n'existe pas !!")
Else
Workbooks.Open (chemin_abs + fichier_abs)
Workbooks(fichier_abs).Activate
'***********************************************************************
'constituer le tableau des personnes-departement pour renseigner
'plus tard les fichiers resu
If (numero_passage = 1) Then
Call remplir_tableau_departement(fichier_abs, nom_macro, boucle_abs)
End If
'************************************************************************
ActiveWorkbook.Sheets(repertoire_abs).Select
'reperer la ligne de la categorie en cours de traitement dans le fichier source
boucle_categorie = 1 'increment de la ligne de categorie dans le fichier source
Workbooks(fichier_abs).Activate
Do While (Cells(boucle_categorie + 4, 1) <> "") '4 lignes d'en tête
If (Cells(boucle_categorie + 4, 1).Formula = categorie) Then
'recuperation des donnees
'il faut une copie speciale par valeur et format sinon on recupere
'la formule du pourcentage et non son resultat
'Attention : la selection G7 indique en premier la colonne G
'mais une selection par coordonnées indique le numero de ligne en 1er
'abs_categorie = Cells(boucle_categorie + 4, 7).Value
Range("G" + CStr(boucle_categorie + 4)).Select
Selection.Copy
Workbooks(fichier_resultat).Activate
ActiveWorkbook.Sheets(nom_onglet(1)).Activate
'reecriture des données
'on recopie en changeant de colonne quand on change de mois
Cells(6, boucle_abs + 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
End If 'fin test categorie
boucle_categorie = boucle_categorie + 1
Workbooks(fichier_abs).Activate
Loop 'fin boucle categorie dans le fichier source mensuel
'recuperation du total des absences du mois (toutes categories)
'en tenant compte des 4 lignes d'en tête et de l'incrementation supplémentaire
'de fin de boucle
Workbooks(fichier_abs).Activate
Range("G" + CStr(boucle_categorie + 4 - 1)).Select
Selection.Copy
Workbooks(fichier_resultat).Activate
ActiveWorkbook.Sheets(nom_onglet(1)).Activate
Cells(7, boucle_abs + 1).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
Workbooks(fichier_abs).Activate
Workbooks(fichier_abs).Close
End If 'fin test existence fichier mensuel
boucle_abs = boucle_abs + 1
Loop 'fin boucle sur les mois
'*****************************************************
'modification des references du graphique en local
'et non pas en reference au modele dans l'onglet macro
'*****************************************************
Workbooks(fichier_resultat).Activate
ActiveWorkbook.Sheets(nom_onglet(1)).Activate
ActiveSheet.ChartObjects("Graphique 4").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartType = xl3DColumnClustered
ActiveChart.SeriesCollection(1).XValues = "='tx abs santé'!R5C2:R5C13"
ActiveChart.SeriesCollection(1).Values = "='tx abs santé'!R6C2:R6C13"
ActiveChart.SeriesCollection(1).Name = "='tx abs santé'!R1C1:R1C13"
ActiveChart.SeriesCollection(2).XValues = "='tx abs santé'!R5C2:R5C13"
ActiveChart.SeriesCollection(2).Values = "='tx abs santé'!R7C2:R7C13"
ActiveChart.SeriesCollection(2).Name = "='tx abs santé'!R7C1"
ActiveChart.Location Where:=xlLocationAsObject, Name:="tx abs santé"
ActiveWindow.Visible = True
Windows(fichier_resultat).Activate
Range("O25").Select
'ActiveWindow.ScrollRow = 10
'************************************************************************************
'************************** debit-credit ********************************************
'************************************************************************************
'boucle sur les fichiers debit_credit des mois de l'année
'il n'y en a pas forcément 12 !!
boucle_debcred = 1
Do While boucle_debcred < 13
'reconstituer le nom du fichier credit-debit
Mid(fichier_creditdebit, 14, 2) = CStr(Format(boucle_debcred, "00"))
'MsgBox (fichier_creditdebit)
If Dir(chemin_creditdebit + fichier_creditdebit) = "" Then
'MsgBox (fichier_creditdebit + " n'existe pas !!")
Else
Workbooks.Open (chemin_creditdebit + fichier_creditdebit)
'reperer les personnels de la categorie en cours de traitement
boucle_personnel = 1 'increment du personnel dans le fichier source
ligne_resultat = 1 'increment du personnel dans le fichier resultat
Workbooks(fichier_creditdebit).Activate
Do While (Cells(boucle_personnel + 1, 1) <> "")
If (Cells(boucle_personnel + 1, 1).Formula = categorie) Then
'recuperation et recopie des donnees
departement = quel_departement(personnel, nom_macro, boucle_debcred)
personnel = Cells(boucle_personnel + 1, 2).Formula
creditdebit = FormatDateTime(Cells(boucle_personnel + 1, 6), vbShortTime)
'MsgBox (categorie + " " + personnel + " ")
'MsgBox (creditdebit)
'reecriture des données
's'il s'agit du mois de janvier, le fichier est vide et on écrit les
'noms au fur et à mesure mais à partir du deuxième mois, il faut
'rechercher l'emplacement du nom s'il existe et eventuellement le creer
Workbooks(fichier_resultat).Activate
ActiveWorkbook.Sheets(nom_onglet(4)).Activate
'cas du 1er mois : on incremente ligne_resultat au fur et a mesure
'de l'ecriture
If (boucle_debcred = 1) Then
Cells(ligne_resultat + 3, 1).Formula = categorie
Cells(ligne_resultat + 3, 2).Formula = departement
'MsgBox (quel_departement(personnel, nom_macro, boucle_debcred))
Cells(ligne_resultat + 3, 3).Formula = personnel
Cells(ligne_resultat + 3, boucle_debcred + 3).Formula = creditdebit
ligne_resultat = ligne_resultat + 1
'cas du 2ième mois et + : rechercher ce personnel dans le fichier
'resultat pour mettre l'info à la bonne ligne
Else
ligne_resultat = 1 'increment du personnel dans le fichier resultat
recopie = False
Do While (Cells(ligne_resultat + 3, 3).Formula <> "")
If (Cells(ligne_resultat + 3, 3).Formula = personnel) Then
Cells(ligne_resultat + 3, boucle_debcred + 3).Formula = creditdebit
recopie = True
Exit Do
End If
ligne_resultat = ligne_resultat + 1
Loop
'si le personnel n'a pas été trouvé, c'est qu'il n'était pas là en
'début d'année : il faut le rajouter à la fin
If Not (recopie) Then
Cells(ligne_resultat + 3, 1).Formula = categorie
Cells(ligne_resultat + 3, 2).Formula = departement
Cells(ligne_resultat + 3, 3).Formula = personnel
Cells(ligne_resultat + 3, boucle_debcred + 3).Formula = creditdebit
End If
End If 'fin test mois
End If 'fin test categorie
Workbooks(fichier_creditdebit).Activate
boucle_personnel = boucle_personnel + 1
Loop 'fin boucle personnel dans le fichier source mensuel
Workbooks(fichier_creditdebit).Activate
Workbooks(fichier_creditdebit).Close
End If 'fin test existence fichier mensuel
boucle_debcred = boucle_debcred + 1
Loop 'fin boucle sur les mois
'************************************************************************************
'******************************* ECR_HPP ********************************************
'************************************************************************************
'boucle sur les fichiers ECR_HPP des mois de l'année
'il n'y en a pas forcément 12 !!
boucle_ECRHPP = 1
Do While boucle_ECRHPP < 13
'MsgBox (CStr(Format(boucle_ECRHPP, "00")))
Mid(fichier_ECR_HPP, 9, 2) = CStr(Format(boucle_ECRHPP, "00"))
'MsgBox (fichier_ECR_HPP)
If Dir(chemin_ECR_HPP + fichier_ECR_HPP) = "" Then
'MsgBox (fichier_ECR_HPP + " n'existe pas !!")
Else
Workbooks.Open (chemin_ECR_HPP + fichier_ECR_HPP)
'reperer les personnels de la categorie en cours de traitement
boucle_personnel = 1 'increment du personnel dans le fichier source
ligne_resultat = 1 'increment du personnel dans le fichier resultat
Workbooks(fichier_ECR_HPP).Activate
' recherche de la categorie dans le fichier de data
Do While (Cells(boucle_personnel + 1, 1) <> "")
If (Cells(boucle_personnel + 1, 1).Formula = categorie) Then
'recuperation et recopie des donnees
departement = quel_departement(personnel, nom_macro, boucle_ECRHPP)
personnel = Cells(boucle_personnel + 1, 2).Formula
ecretage = FormatDateTime(Cells(boucle_personnel + 1, 6), vbShortTime)
HPP = FormatDateTime(Cells(boucle_personnel + 1, 7), vbShortTime)
'MsgBox (categorie + " " + personnel + " ")
'MsgBox (HPP)
'reecriture des données HPP
's'il s'agit du mois de janvier, le fichier est vide et on écrit les
'noms au fur et à mesure mais à partir du deuxième mois, il faut
'rechercher l'emplacement du nom s'il existe et eventuellement le creer
Workbooks(fichier_resultat).Activate
'cas du premier mois : on incremente la ligne_resultat au fur et a
'mesure de l'ecriture
If (boucle_ECRHPP = 1) Then
'reecriture des données HPP
ActiveWorkbook.Sheets(nom_onglet(3)).Activate 'HPP
Cells(ligne_resultat + 4, 1).Formula = categorie
Cells(ligne_resultat + 4, 2).Formula = departement
Cells(ligne_resultat + 4, 3).Formula = personnel
Cells(ligne_resultat + 4, boucle_ECRHPP + 3).Formula = HPP
'reecriture des données "ecretage"
ActiveWorkbook.Sheets(nom_onglet(2)).Activate 'ecretage
Cells(ligne_resultat + 3, 1).Formula = categorie
Cells(ligne_resultat + 3, 2).Formula = departement
Cells(ligne_resultat + 3, 3).Formula = personnel
Cells(ligne_resultat + 3, boucle_ECRHPP + 3).Formula = ecretage
ligne_resultat = ligne_resultat + 1
'cas du 2ième mois et suivants : rechercher directement ce personnel
'dans le fichier resultat
Else
Workbooks(fichier_resultat).Activate
'reecriture des données HPP
ActiveWorkbook.Sheets(nom_onglet(3)).Activate 'HPP
ligne_resultat = 1 'increment du personnel dans le fichier resultat
recopie = False
Do While (Cells(ligne_resultat + 4, 3).Formula <> "")
If (Cells(ligne_resultat + 4, 3).Formula = personnel) Then
Cells(ligne_resultat + 4, boucle_ECRHPP + 3).Formula = HPP
recopie = True
Exit Do
End If
ligne_resultat = ligne_resultat + 1
Loop
'si le personnel n'a pas été trouvé, c'est qu'il n'était pas là en
'début d'année : il faut le rajouter à la fin
If Not (recopie) Then
Cells(ligne_resultat + 4, 1).Formula = categorie
Cells(ligne_resultat + 4, 2).Formula = departement
Cells(ligne_resultat + 4, 3).Formula = personnel
Cells(ligne_resultat + 4, boucle_ECRHPP + 3).Formula = HPP
End If
'reecriture des données "ecretage"
ActiveWorkbook.Sheets(nom_onglet(2)).Activate 'ecretage
ligne_resultat = 1 'increment du personnel dans le fichier resultat
recopie = False
Do While (Cells(ligne_resultat + 3, 3).Formula <> "")
If (Cells(ligne_resultat + 3, 3).Formula = personnel) Then
Cells(ligne_resultat + 3, boucle_ECRHPP + 3).Formula = ecretage
recopie = True
Exit Do
End If
ligne_resultat = ligne_resultat + 1
Loop
'si le personnel n'a pas été trouvé, c'est qu'il n'était pas là en début d'année :
'il faut le rajouter à la fin
If Not (recopie) Then
Cells(ligne_resultat + 3, 1).Formula = categorie
Cells(ligne_resultat + 3, 2).Formula = departement
Cells(ligne_resultat + 3, 3).Formula = personnel
Cells(ligne_resultat + 3, boucle_ECRHPP + 3).Formula = ecretage
End If
End If 'fin test mois
End If 'fin test categorie
Workbooks(fichier_ECR_HPP).Activate
boucle_personnel = boucle_personnel + 1
Loop 'fin boucle personnel dans le fichier source mensuel
Workbooks(fichier_ECR_HPP).Activate
Workbooks(fichier_ECR_HPP).Close
End If 'fin test existence fichier mensuel
boucle_ECRHPP = boucle_ECRHPP + 1
Loop 'fin boucle sur les mois
'************************************************************************
'*** ajout des sommes horaires en fin de constitution de fichier resu ***
'************************************************************************
Workbooks(fichier_resultat).Activate
'************************************
'ajout des sommes des heures ecretage
'************************************
ActiveWorkbook.Sheets(nom_onglet(2)).Activate 'ecretage
Range("P3").Formula = "Total"
Range("P4").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
'je prends la colonne "C" du personnel
lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
'somme des lignes dans la dernière colonne
Selection.AutoFill Destination:=Range("P4:P" + CStr(lastrow))
'somme des colonnes dans la dernière ligne
Range("C" + CStr(lastrow + 1)).Formula = "Total"
decalage_ligne = lastrow - 3
Range("D" + CStr(lastrow + 1)).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" + CStr(decalage_ligne) + "]C:R[-1]C)"
Selection.AutoFill Destination:=Range("D" + CStr(lastrow + 1) + ":O" _
+ CStr(lastrow + 1))
Range("A1:P" + CStr(lastrow + 1)).Select
grille
'*****************************************
'ajout des sommes des heures et grille HPP
'*****************************************
ActiveWorkbook.Sheets(nom_onglet(3)).Activate 'HPP
Range("P4").Formula = "Total"
Range("P5").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
'je prends la colonne "C" du personnel
lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Selection.AutoFill Destination:=Range("P5:P" + CStr(lastrow))
Range("A1:P" + CStr(lastrow)).Select
grille
'*****************************************
'***** grille credit debit ***************
'*****************************************
ActiveWorkbook.Sheets(nom_onglet(4)).Activate 'credit-debit
lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Range("A1:O" + CStr(lastrow)).Select
grille
'*****************************************************
'fin de constitution du fichier resultat : fermeture !
'*****************************************************
Workbooks(fichier_resultat).Activate
ActiveWorkbook.SaveAs Filename:=chemin_resultat + fichier_resultat, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Workbooks(fichier_resultat).Close
Else
'MsgBox ("pas de fichier resu")
End If
boucle_fichier_resu = boucle_fichier_resu + 1
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("macro").Activate
'mise a jour d'ecran pour la petite croix signalant la progression
Application.ScreenUpdating = True
Range("C" + CStr(boucle_fichier_resu)).Formula = ""
Range("C" + CStr(boucle_fichier_resu + 1)).Select
Range("C" + CStr(boucle_fichier_resu + 1)).Formula = "*"
Application.ScreenUpdating = False
Loop
'fin de boucle sur la liste des resultats
'restitution de la configuration originale de Excell
'et nettoyage de l'onglet temporaire de la macro
Application.SheetsInNewWorkbook = nombre_de_feuilles
'MsgBox (Application.SheetsInNewWorkbook)
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("temporaire").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
ActiveWorkbook.Sheets("macro").Activate
Range("C" + CStr(boucle_fichier_resu + 1)).Formula = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Range("A1").Select
MsgBox ("c'est fini !")
End Sub
Function grille() As Boolean
'Range("D28:F34").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End Function
Function remplir_tableau_departement(ByVal fichier_abs As String, _
ByVal nom_macro As String, _
ByVal numero_fichier As Integer) As Boolean
Dim lastrow As Integer
Workbooks(fichier_abs).Activate
ActiveWorkbook.Sheets("Base").Activate
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A1:A" + CStr(lastrow)).Select
Selection.Copy
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("temporaire").Activate
Cells(1, (numero_fichier - 1) * 2 + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Workbooks(fichier_abs).Activate
ActiveWorkbook.Sheets("Base").Activate
Range("K1:K" + CStr(lastrow)).Select
Selection.Copy
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("temporaire").Activate
Cells(1, (numero_fichier - 1) * 2 + 2).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A1").Select
Workbooks(fichier_abs).Activate
ActiveWorkbook.Sheets("Base").Activate
Range("A1").Select
End Function
Function quel_departement(ByVal personnel As String, _
ByVal nom_macro As String, _
ByVal numero_fichier As Integer) As String
Dim colonne, ligne As Integer
Dim fichier_en_cours, onglet_en_cours As String
'memoriser la selection du fichier et de l'onglet en cours
'pour les reactiver en fin de procedure
fichier_en_cours = ActiveWorkbook.Name
onglet_en_cours = ActiveSheet.Name
Workbooks(nom_macro).Activate
ActiveWorkbook.Sheets("temporaire").Activate
colonne = (numero_fichier - 1) * 2 + 1
ligne = 2
Do While (Cells(ligne, colonne) <> "")
If (Cells(ligne, colonne).Formula = personnel) Then
quel_departement = Cells(ligne, colonne + 1).Formula
'MsgBox ("coucou" + personnel + " " + Cells(ligne, colonne + 1).Formula)
Exit Do 'on a trouvé le departement
End If
ligne = ligne + 1
Loop
'reactiver fichier et onglet comme au debut de cette procedure
Workbooks(fichier_en_cours).Activate
ActiveWorkbook.Sheets(onglet_en_cours).Activate
End Function
EDIT : Ajout des balises de code (la coloration syntaxique). Explications disponibles ici :ICI