Rajouter "une phrase" en VBA

Le 18/12/2013 à 10:44

Bonjour le forum,

J’ai une macro ci-dessous (merci beaucoup à Dan !). Elle doit ouvrir plusieurs fichiers. Elle a fonctionné très bien jusqu’au le moment quand j’ai rajouté des macros dans chaque fichier.

Maintenant, pendant son exécution, la macro m’informe que le fichier contient des macros et me demande « Activer les macros ? » Ma réponse est toujours positive. Je sais qu’il y a des macros et je veux les activer.

Est-ce que quelqu’un peut m’aider et rajouter le code VBA nécessaire pour pouvoir automatiser entièrement cette exécution ?

Merci d’avance !

Cordialement

Baton

Sub startupdate()
'Macro Dan pour Baton 
Dim Rep As String
Dim REPER As String
Dim tv
Dim lg As Byte
lg = 44
If IsEmpty(Range("E" & lg)) Then Range("E" & lg) = 0
If IsEmpty(Range("F" & lg)) Then Range("F" & lg) = 0
If IsEmpty(Range("G" & lg)) Then Range("G" & lg) = 0
tv = Range("E" & lg) & ":" & Range("F" & lg) & ":" & Range("G" & lg)
Rep = "Gestion:contrats de recherche:Base Contrats:"
REPER = "Gestion:Echanges_et_comptes_a_suivre:"
Workbooks.Open Rep & "AERES.xls"
Windows(1).WindowState = xlMinimized
Workbooks.Open REPER & "Gregory_Echanges_entre_equipes.xlsm"
Windows(1).WindowState = xlMinimized
Application.OnTime Now + TimeValue(tv), "som"
End Sub
Sub som()
Dim depart, fin
depart = Now
'....code lines of macro som
Dim MasterWbk As Workbook
    Dim i As Long, cel As Range
    Dim passwords
    Application.ScreenUpdating = False
    Set MasterWbk = ThisWorkbook
    passwords = Array("aaa", "bbb", "ccc", "ddd", "eee", "fff", "ggg", "hhh", "iii", "jjj", "kkk", "lll", "mmm", "nnn", "ooo", "ppp", "qqq", "rrr", "sss", "ttt")
    MasterWbk.ActiveSheet.[C4:G7,C10:G18,C20:G21,C23:G26,C29:G32,C34:G37,L4:P7,L10:P18,L20:P21,L23:P26,L29:P32,L34:P37].ClearContents
    For i = 1 To 20
        Workbooks.Open "Gestion:web:telechargement:BD_equipe_" & i & ".xlsm", UpdateLinks:=3, Password:=passwords(i - 1)
             For Each cel In Sheets("Recap1").[C4:G7,C10:G18,C20:G21,C23:G26,C29:G32,C34:G37,L4:P7,L10:P18,L20:P21,L23:P26,L29:P32,L34:P37]
            MasterWbk.ActiveSheet.Range(cel.Address) = MasterWbk.ActiveSheet.Range(cel.Address) + cel.Value
        Next cel
        ActiveWorkbook.Close False
         Next i
    Workbooks("AERES.xls").Close SaveChanges:=False
    Workbooks("Gregory_Echanges_entre_equipes.xlsm").Close SaveChanges:=True
fin = Now
MsgBox Format(fin - depart, "hh:mm:ss")
End Sub
Le 18/12/2013 à 11:13
Application.DisplayAlerts = False

Avec selfcert.exe

Le 18/12/2013 à 11:50

EngueEngue,

merci pour ta réponse.

J'ai rajouté ton code 3 fois après les commandes Workbooks.Open et essayé d'exécuter la macro. Peut-être je me suis trompé avec l'emplacement de ta phrase, mais ça n'a pas fonctionné.

EngueEngue a écrit :
Application.DisplayAlerts = False

A quoi cers ça?

Avec selfcert.exe

Merci

Baton

Sub startupdate()
'Macro Dan pour Baton le 02/12/11
Dim Rep As String
Dim REPER As String
Dim tv
Dim lg As Byte
lg = 44
If IsEmpty(Range("E" & lg)) Then Range("E" & lg) = 0
If IsEmpty(Range("F" & lg)) Then Range("F" & lg) = 0
If IsEmpty(Range("G" & lg)) Then Range("G" & lg) = 0
tv = Range("E" & lg) & ":" & Range("F" & lg) & ":" & Range("G" & lg)
Rep = "Gestion:contrats de recherche:Base Contrats:"
REPER = "Gestion:Echanges_et_comptes_a_suivre:"
Workbooks.Open Rep & "AERES.xls"
Application.DisplayAlerts = False
Windows(1).WindowState = xlMinimized
Workbooks.Open REPER & "Gregory_Echanges_entre_equipes.xlsm"
Application.DisplayAlerts = False
Windows(1).WindowState = xlMinimized
Application.OnTime Now + TimeValue(tv), "som"
End Sub
Sub som()
Dim depart, fin
depart = Now
'....code lines of macro som
Dim MasterWbk As Workbook
    Dim i As Long, cel As Range
    Dim passwords
    Application.ScreenUpdating = False
    Set MasterWbk = ThisWorkbook
    passwords = Array("aaa", "bbb", "ccc", "ddd", "eee", "fff", "ggg", "hhh", "iii", "jjj", "kkk", "lll", "mmm", "nnn", "ooo", "ppp", "qqq", "rrr", "sss", "ttt")
    MasterWbk.ActiveSheet.[C4:G7,C10:G18,C20:G21,C23:G26,C29:G32,C34:G37,L4:P7,L10:P18,L20:P21,L23:P26,L29:P32,L34:P37].ClearContents
    For i = 1 To 1 '20
         Workbooks.Open "Gestion:web:telechargement:BD_equipe_" & i & ".xlsm", UpdateLinks:=3, Password:=passwords(i - 1)
   Application.DisplayAlerts = False
        'For Each cel In Sheets("Recap1").[C4:g35,C37:g38,l4:p35,l37:p38]
        For Each cel In Sheets("Recap1").[C4:G7,C10:G18,C20:G21,C23:G26,C29:G32,C34:G37,L4:P7,L10:P18,L20:P21,L23:P26,L29:P32,L34:P37]
            MasterWbk.ActiveSheet.Range(cel.Address) = MasterWbk.ActiveSheet.Range(cel.Address) + cel.Value
        Next cel
        ActiveWorkbook.Close False
        'End If
    Next i
    Workbooks("AERES.xls").Close SaveChanges:=False
    Workbooks("Gregory_Echanges_entre_equipes.xlsm").Close SaveChanges:=True
fin = Now
MsgBox Format(fin - depart, "hh:mm:ss")
End Sub
Rechercher des sujets similaires à "rajouter phrase vba"