Corriger le code VBA
Bonjour Forum,
PJ : Fichier PDF Procédure étape par étape, qui explique les traitements réalisés par la macro ( https://drive.google.com/open?id=1o5V_6i1yIDnHqD8NGXostjFH7PDjaajS ).
Je sollicite votre aide pour régler cette macro.
On l'a modifié pour l'éxécuter jusqu'au bout.
Ce passage ne permet pas de remplir les fichiers concernés en décalant de plusieurs colonnes pour y inscrire les nouveaux chiffres ou formules.
Workbooks(unFichier).Activate
Call RemplirFichierIndicateur.addValue(numberDSCC, numberSuivi, dateOfDir, unFichier, fichier_source, inputDate, dateOfFile, dateExtraction, numberDOMTOMDTC)
Les données entre parenthèses sont bien valorisées, mais le Call RemplirFichierIndicateur n'est pas défini et détaillé ici.
Voici la macro en totalité si besoin :
Private Sub openFile()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim repertoire As String
Dim wbook As Workbook
Dim inputDate As String
Dim bookName As String
Dim numberDSCC As String, numberDOMTOMDTC As String, numberSuivi As String, day As String, month As String, year As String, dateOfDir As String, dateOfFile As String
Dim test_numberSuivi As Boolean
Dim dateExtraction As String
Dim unFichier As Variant
Dim fichier_source As String
Dim path1 As String, test As Boolean
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
fichier_source = ActiveWorkbook.Name 'le nom est récupéré lorsque l'utilisateur lance la macro depuis le fichier indicateur
'Vérifier que la macro est lancée à partir du fichier indicateur
If Not fichier_source Like "Suivi avancement*" Then
MsgBox "Veuillez lancer la macro depuis le fichier indicateur"
Exit Sub
End If
Dim file_macro As String, file_exportPA As String, WB_count As String, X As Integer
WB_count = Workbooks.Count
For X = 1 To WB_count ' permet de récupérer le nom du fichier contenant le code VBA
If Workbooks(X).Name Like "Macro_*" Then
file_macro = Workbooks(X).Name
Exit For
End If
Next X
For X = 1 To WB_count ' permet de récupérer le nom du fichier exportPA
If Workbooks(X).Name Like "exportPA*" Then
file_exportPA = Workbooks(X).Name
Exit For
End If
Next X
'Vérifier que le fichier exportPA a été ouvert
If file_exportPA = "" Then
MsgBox "Veuillez ouvrir le fichier exportPA"
Exit Sub
End If
test = False
path1 = Workbooks(file_macro).Sheets(1).Cells(10, 1) 'Récupère le chemin ajouté par l'utilisateur
If path1 = "" Then
MsgBox "Veuillez indiquer le dossier contenant les fichiers Gestion des activités"
Exit Sub
End If
dateI:
inputDate = InputBox("Choix du dossier pour remplir le fichier indicateur. La date doit être SEULEMENT au format JJ_MM_AAAA. Saisir la date : ")
If StrPtr(inputDate) = 0 Then 'Si l'utilisateur clique sur le bouton annulé, annule la procédure
Exit Sub
End If
'Récupère la date ajoutée par l'utilisateur et récupère la date, le mois et l'année
'pour les fichiers de François car les dates sont au format AAAAMMJJ. Les fichiers concernés sont : DSCC_NbAgentsHorsPIC, exportPA et IndicateurV2
day = Left(inputDate, 2)
month = Mid(inputDate, 4, 2)
year = Right(inputDate, 4)
dateOfFile = year & month & day
'Condition permettant de vérifier que les fichiers sont dans le dossier
If Dir(path1 & "\" & "\IndicateurV2_" & dateOfFile & ".xlsx") <> "" Then
Set other = Workbooks.Open(path1 & "\" & "\IndicateurV2_" & dateOfFile & ".xlsx", , False) 'Permet d'ouvrir le fichier indicateur en mode lecture/écriture
Else
MsgBox "Le fichier IndicateurV2_" & dateOfFile & " est introuvable"
Exit Sub
End If
If Dir(path1 & "\" & "\DSCC_NbAgentsHorsPIC_" & dateOfFile & ".xlsx") <> "" Then
Set other = Workbooks.Open(path1 & "\" & "\DSCC_NbAgentsHorsPIC_" & dateOfFile & ".xlsx", , False) 'Permet d'ouvrir le fichier indicateur en mode lecture/écriture
Else
MsgBox "Le fichier DSCC_NbAgentsHorsPIC_" & dateOfFile & " est introuvable"
Exit Sub
End If
repertoire = path1 & "\" & "\"
unFichier = Dir(repertoire & "Gestion des activités*.xl*")
'Si l'utilisateur clique sur le bouton annulé, annule la procédure
If StrPtr(inputDate) = 0 Then
Exit Sub
'Condition si l'utilisateur se trompe de date donc le dossier ne peut pas être trouvé
'ou si dans le dossier il n'y a pas les fichiers alors cela réaffiche la fenêtre
ElseIf unFichier = "" Then
MsgBox "Dossier non trouvé, date incorrecte ou aucun fichier dans le dossier"
GoTo dateI
End If
'&&&&&&&&&&&&&&&&&&&&&&&&&
'Boucle qui effectue les traitements sur tous les fichiers du dossier
While unFichier <> ""
'Ouvre en lecture/écriture les fichiers à traiter du dossier
Set wbook = Workbooks.Open(repertoire & unFichier, , False)
'récupère le nom du fichier
bookName = wbook.Name
'Ces conditions sont nécessaires lorsque le numéro de suivi est supérieur ou égale à 10
test_numberSuivi = True
'récupère le numéro de suivi
numberSuivi = Mid(bookName, 41, 2)
If numberSuivi Like "* " Then
'enlever l'espace à la fin de la variable numberSuivi
numberSuivi = Left(numberSuivi, 1)
test_numberSuivi = False
End If
'récupère la DSCC
numberDSCC = Right(bookName, 11)
numberDSCC = Left(numberDSCC, 6)
day = Left(inputDate, 2)
month = Mid(inputDate, 4, 2)
'obtenir la date en version JJ/MM => Variable pour remplir la cellule à côté de la cellule contenant la valeur "Suivi X" (X numéro du suivi) et mettre au format JJ/MM + N° suivi
dateOfDir = day & "/" & month
'Cette variable permet de pouvoir filtrer dans le fichier IndicateurV2 la date du tableau croisé dynamique
dateExtraction = day & "/" & month & "/" & year
Workbooks(unFichier).Activate
Call RemplirFichierIndicateur.addValue(numberDSCC, numberSuivi, dateOfDir, unFichier, fichier_source, inputDate, dateOfFile, dateExtraction, numberDOMTOMDTC)
Application.DisplayAlerts = False
Workbooks(unFichier).Save
Workbooks(unFichier).Close
Application.DisplayAlerts = True
unFichier = Dir
Wend
Application.Goto Worksheets(1).Range("C1"), True
Workbooks("IndicateurV2_" & dateOfFile & ".xlsx").Save
Workbooks("IndicateurV2_" & dateOfFile & ".xlsx").Close
Workbooks("DSCC_NbAgentsHorsPIC_" & dateOfFile & ".xlsx").Save
Workbooks("DSCC_NbAgentsHorsPIC_" & dateOfFile & ".xlsx").Close
Application.DisplayAlerts = False
Workbooks(file_macro).Save
Workbooks("exportPA_" & dateOfFile & ".xlsx").Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Macro exécutée"
End Sub