Erreur 1004 et 32809
many62
-
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention -
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:
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 Merci d'y penser dans tes prochains messages. |
A voir également:
- Erreur 1004 et 32809
- Erreur 0x80070643 - Accueil - Windows
- Erreur 0x80070643 Windows 10 : comment résoudre le problème de la mise à jour KB5001716 - Accueil - Windows
- J'aime par erreur facebook notification - Forum Facebook
- Dans la table des matières du document à télécharger, le chapitre 6 et ses 2 sections n'apparaissent pas. trouvez l'erreur dans la structure du document et corrigez-la. mettez à jour la table des matières. quel est le mot formé par les lettres en majuscules de la table des matières après sa mise à jour ? - Forum Word
- Code erreur f3500-31 ✓ - Forum Bbox Bouygues