Discussion :

[Kelexel]

Bonjour


J'ai actuellement un répertoire intitulé "2015" qui comprend 52 répertoires intitulés de S01 à S52 et contenant chacun un classeur s'appelant "Synthese.xlsm".

Ce fichier à une macro dénommée "Actualiser", servant à mettre à jour les liens contenus dedans.

Vu la quantité importe de liens présents, il faut environ 6 minutes pour que la macro finisse sa tache. Vu la quantité de fichiers à actualiser, ca me prendrait trop de temps (car je ne peux pas bosser lors de l'actualisation de la macro, excel est figé).


Pourriez-vous m'aider à créer une macro qui :
- se place dans le repertoire 2015
- ouvre le fichier "Synthese.xlsm" du repertoire S01
- y lancer la macro "actualisation"
- enregistre et sort du fichier
puis recommence mais avec le répertoire S02 etc

comme ça le soir, je lance cette macro, comme ça le lendemain en arrivant les fichiers sont prêts!

J'ai bossé sur cette macro mais :
- elle ouvre et lance bien la macro en question mais ne sauvegarde pas et clos directement une fois que la macro a fini son travail, je ne sais donc pas si tout a fonctionné comme il faut.
- elle n'ouvre qu'un seul fichier et ne lance pas le suivant situé ailleurs

Pouvez-vous m'aider?

Je vous remercie par avance

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
 
Option Explicit
 
Sub RunMacro_NoArgs()
'Macro purpose:  To demonstrate using the run method to execute
'a macro without arguments from another workbook
 
    Dim wbTarget As Workbook, _
        CloseIt As Boolean
 
    'Attempt to set the target workbook to a variable.  If an error is
    'generated, then the workbook is not open, so open it
    On Error Resume Next
        Set wbTarget = Workbooks(Sheets(1).Range("B9"))
 
        If Err.Number <> 0 Then
            'Open the workbook
            Err.Clear
            Set wbTarget = Workbooks.Open(Sheets(1).Range("B8") _
                & "\" & Sheets(1).Range("B9"))
            CloseIt = True
        End If
 
        'Check and make sure workbook was opened
        If Err.Number = 1004 Then
            MsgBox "Sorry, but the file you specified does not exist!" _
                & vbNewLine & Sheets(1).Range("B8") & "\" & Sheets(1).Range("B9")
            Exit Sub
        End If
    On Error GoTo 0
 
    'Run the macro!  (You will need to update "SimpleMacro" to the
    'name of the macro you wish to run)
    Application.Run (wbTarget.Name & "!Actualiser")
 
    If CloseIt = True Then
        'If the target workbook was opened by the macro, close it
        wbTarget.Close savechanges:=False
    Else
        'If the target workbook was already open, reactivate this workbook
        ThisWorkbook.Activate
    End If
 
End Sub

[pgz]

Bonsoir.

Je te propose ce code qui va chercher dans le dossier "2015" et dans tous les sous-dossier SII un classeur "Synthese.xlsm", l'ouvre, exécute sa macro "Actualiser", l'enregistre et le ferme.

Le code est assez simple et doit être placé dans un module standard d'un classeur outil enregistré lui-même à côté du dossier "2015".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub subUpdateAllWOrkbooks()
Dim s2015Folder As String 'chemin du dossier 2015
Dim iWeek As Integer 'num de semaine
Dim oWbk As Excel.Workbook
Dim sErr As String
 
'effacer le CR de la dernière exécution
ThisWorkbook.Worksheets(1).Range("A1").Value = vbNullString
 
'le présent classeur doit être placé à côté du dossier 2015
s2015Folder = ThisWorkbook.Path & "\2015"
 
'scruter les répertoires hebdo
For iWeek = 1 To 52
    On Error Resume Next
        Set oWbk = Application.Workbooks.Open(s2015Folder & "\S" & Format(iWeek, "00") & "\Synthese.xlsm")
 
        If Err.Number <> 0 Then
            sErr = sErr & vbCrLf & "Le classeur de la semaine " & Format(iWeek, "00") & " n'a pas été trouvé."
        Else
            Application.Run oWbk.Name & "!Actualiser"
 
            If Err.Number <> 0 Then
                sErr = sErr & vbCrLf & "Le classeur de la semaine " & Format(iWeek, "00") & " n'a pas été mis à jour."
            Else
                DoEvents
                oWbk.Save
            End If
 
            oWbk.Close
        End If
 
    On Error GoTo 0
Next iWeek
 
'CR d'exécution
ThisWorkbook.Worksheets(1).Range("A1").Value = "Mise à jour terminée." & IIf(sErr = vbNullString, " RAS", " Des problèmes sont survenus : " & sErr)
 
Set oWbk = Nothing
 
End Sub

Un compte-rendu d'exécution est donné en A1 de la première feuille du classeur outil.

Cordialement,

PGZ

[Kelexel]

Super, j'ai lancé la macro.

J'ai du desactiver la question concernant la mise à jour des liaisons mais j'ai oublié celle concernant l'avertissement sur la confidentialité !

J'ai lancé un test sur 10 semaines.

Ca a l'air de fonctionner !!

Un très GROS MERCI pour cet excellent travail !!

ps : je tente de me mettre au VBA, est ce que tu peux me dire comment tu l'as appris?

[kiki29]

Salut, question à 100 balles : ce ne serait pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Run "'" & oWbk.Name & "!Actualiser"

plutôt que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.Run oWbk.Name & "!Actualiser"

?

[pgz]

Bonjour. Comme ici les classeurs s'appellent Synthese, il n'y a pas besoin des apostrophes. Mais dès que le nom de classeur contient un espace, il en faut.
Et donc, à mon avis, tu as gagné tes 100 balles

Bonne journée,

PGZ

[Kelexel]

J'ai lancé le test grandeur nature sur ma bécane en ayant récuperer les fichiers du bureau.

Ca a fonctionné parfaitement... jusqu'à la S32... car le pc s'est mis en veille...

Sinon comme ton code est simple et clair, j'ai pu l'adapter à d'autres classeurs, tout fonctionne parfaitement !!!

Encore merci pour ta précieuse aide (le temps de traitement de la Synthese est en 5h30 environ cumulée, un gain de temps de dingue du coup!!!!)