Erreur 1004 et 32809

Fermé
many62 - Modifié par jordane45 le 19/10/2016 à 12:09
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 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

Merci d'y penser dans tes prochains messages.



1 réponse

f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
19 oct. 2016 à 13:52
Bonjour,

Sans le fichier, pas vraiment possible de vous repondre!!!
Sans la ou les lignes d'erreur, impossible
0