Sub Consolidation()
'Procédure qui permet de remonter les informations dans un fichier de consolidation
'La base de donnée BDD de chaque agent sera centralisé sur un fichier commun permettant
'le traitement de l'ensemble des informations collectées
'Procédure enregistrée par Anthony Bourgis & Geoffrey Lebeau
Dim i As Integer
Dim NomFichierConso As String
Const FTYPE_XLS As String = "Fichier Excel,*.xls"
Dim maj
Dim maj2
Feuil2.Unprotect
NomFichierConso = UserForm3.TextBox2.Value
If FileExists(NomFichierConso) Then
' test pour voir si le fichier de consolidation enregistré dans les paramètres existe
maj = msgbox("Souhaitez vous enregistrer les données dans le fichier suivant:" & Chr(13) _
& Chr(13) _
& NomFichierConso & Chr(13) _
& Chr(13) _
& "Cliquez NON pour choisir un autre fichier.", vbQuestion + vbYesNoCancel + 256, "Attention")
Select Case maj
Case vbYes
GoTo Procedure
Case vbNo
NomFichierConso = Application.GetOpenFilename(FTYPE_XLS)
ThisWorkbook.Activate
Feuil2.Cells(12, 2).Value = NomFichierConso
UserForm3.TextBox2.text = NomFichierConso
GoTo Procedure
Case vbCancel
End Select
Else
maj2 = msgbox("Sélectionner le fichier de Consolidation :", vbQuestion + vbOKCancel + 256, "Attention")
Select Case maj2
Case vbOK
NomFichierConso = Application.GetOpenFilename(FTYPE_XLS)
ThisWorkbook.Activate
Feuil2.Cells(12, 2).Value = NomFichierConso
UserForm3.TextBox2.text = NomFichierConso
GoTo Procedure
Case vbCancel
End Select
End If
Feuil2.Protect
Exit Sub
Procedure:
On Error Resume Next
i = 0
Range("A3").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
Range(Cells(4, 1), Cells(i + 2, 26)).Select 'Permet de sélectionner la plage contenant
'les informations et le reporting
Application.CutCopyMode = False
Selection.Copy
Workbooks.Open Filename:=NomFichierConso
'ouverture du fichier de consolidation
Sheets("base TCD").Activate
Range("a1").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste 'On colle la plage sélectionnée dans le fichier consolidé
ActiveWorkbook.Close 'Ferme le classeur : consolidé.xls
ActiveWorkbook.Select
Feuil2.Cells(22, 11).Value = "=TODAY()"
'*** à remettre
'Feuil3.Unprotect
'Selection.Delete 'On efface la sélection
'Feuil3.Protect 'On efface la sélection
'' *** Ne pas supprimer les données pour le moment. ***
'' Si l'automatisme est mis en place, la suppression des appels saisis sera irréversible
'' cela laisse un "droit à l'erreur" + laisse la liberté à l'agent de supprimer les données à la fréquence souhaitée
arret:
End Sub