Autres desactiver les macros a partir d'un autre classeur

BIL boud

XLDnaute Occasionnel
bonjour

j'ai un classeur apartir duquel je fait l'importation de données a partir de 5 autres classeur, le probleme c que a chaque fois je lance ma macro les message (des louverture ) des autres classeur s'affichent, je ne sais pas si ya une solution pour empêcher l'affichage de messages des autres fichier

merci pour vos reponses
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Je dirais bien Application.DisplayAlerts = false en tête de macro qui ouvre les fichiers mais comment savoir sans le moindre exemple de code, ni plus de détail sur la nature et l'origine des messages?

bon après-midi et bonnes recherches
 

BIL boud

XLDnaute Occasionnel
Bonjour,

Je dirais bien Application.DisplayAlerts = false en tête de macro qui ouvre les fichiers mais comment savoir sans le moindre exemple de code, ni plus de détail sur la nature et l'origine des messages?

bon après-midi et bonnes recherches


VB:
Sub Feuil_1(wsh0, test0, last0)



a = Workbooks(wb1).Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles



For f = 1 To 11                 'boucle sur les feuilles
If a(f, 1) <> "" And a(f, 1) = wsh0 Then
   derlin = Workbooks(wb1).Worksheets(wsh0).Range("a65000").End(xlUp).row ' derniere ligne de la feuille (wsh1) de classeur omega1
   derlavl = Workbooks(wb).Worksheets(wsh).Range("c65000").End(xlUp).row
  
   If derlin <> 1 Then
Application.StatusBar = "Debut de test iOMEGA_1"
    'test ligne
    derliac0 = Workbooks(wb).Worksheets(wsh0).Range("an65000").End(xlUp).row
    For i2 = 2 To derliac0
     If Workbooks(wb).Worksheets(wsh0).Cells(i2, 40) = "OMEGA 1" Then
       test0 = Workbooks(wb).Worksheets(wsh0).Cells(i2, 40).row
     End If
    Next i2
  
  
   If test0 <> "" And derlin > test0 Then
     n2 = derlin - test0
     Workbooks(wb).Worksheets(wsh0).Rows(test0 + 1).Resize(n2).Insert
   ElseIf test0 = "" And derlin >= 2 Then
   Workbooks(wb).Worksheets(wsh0).Rows(2).Resize(derlin - 1).Insert
   End If
  'fin tets

Application.StatusBar = "premiere importation d'activites iOMEGA_1"
If test0 = "" Then ' premiere importation
      For i = derlin To 2 Step -1
      Workbooks(wb).Worksheets(wsh0).Cells(i, 40) = "OMEGA 1"
              For iavl = derlavl To 2 Step -1
                For j = 1 To 5000
                If Workbooks(wb1).Worksheets(wsh0).Cells(i, j) <> "" Then
                 If LCase(ch_sans_accent(Workbooks(wb1).Worksheets(wsh0).Cells(i, 4))) = LCase(ch_sans_accent(Workbooks(wb).Worksheets(wsh).Cells(iavl, 3))) Then
                  Workbooks(wb).Worksheets(wsh0).Cells(i, j) = Workbooks(wb1).Worksheets(wsh0).Cells(i, j)
                 End If
                 End If
                Next j
              Next iavl
              For i3 = 2 To derlin
              last0 = Workbooks(wb).Worksheets(wsh0).Range("a" & i3).row + 1
              Next i3
      Next i

Application.StatusBar = "fin de premiere importation iOMEGA_1"

ElseIf test0 = derlin Then  'soit si on a rajoute des lignes a la BDD source soit yavait pas de modif dans la BDD source
Application.StatusBar = "Decalage iOMEGA_1"
        'decaler les données existantes deja en fonctio de decalage de fichier sources
            
            For ii = 2 To derlin
             For i = 2 To derlin
              If Workbooks(wb).Worksheets(wsh0).Cells(ii, 1) <> "" Then
              If Workbooks(wb1).Worksheets(wsh0).Cells(i, 1) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 5) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 6) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 6) Then
                lig1 = Workbooks(wb1).Worksheets(wsh0).Cells(i, 1).row
                lig2 = Workbooks(wb).Worksheets(wsh0).Cells(ii, 1).row
                If lig1 < lig2 Then
                Workbooks(wb).Worksheets(wsh0).Rows(ii).Cut Workbooks(wb).Worksheets(wsh0).Rows(lig1)
                End If
                End If
              End If
              
              Next i
            Next ii
            
            For ii = derlin To 2 Step -1
             For i = derlin To 2 Step -1
             If Workbooks(wb).Worksheets(wsh0).Cells(ii, 1) <> "" Then
              If Workbooks(wb1).Worksheets(wsh0).Cells(i, 1) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 5) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 6) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 6) Then
                lig1 = Workbooks(wb1).Worksheets(wsh0).Cells(i, 1).row
                lig2 = Workbooks(wb).Worksheets(wsh0).Cells(ii, 1).row
                If lig1 > lig2 Then
                Workbooks(wb).Worksheets(wsh0).Rows(ii).Cut Workbooks(wb).Worksheets(wsh0).Rows(lig1)
                End If
              End If
              End If
              Next i
            Next ii

Application.StatusBar = "Importation de nouvelles activites iOMEGA_1"
           For i = derlin To 2 Step -1
           Workbooks(wb).Worksheets(wsh0).Cells(i, 40) = "OMEGA 1"
           'apres le decalage, importer les données rajoutées dans les fichier sources
           If Workbooks(wb1).Worksheets(wsh0).Cells(i, 1) <> Workbooks(wb).Worksheets(wsh0).Cells(i, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 5) <> Workbooks(wb).Worksheets(wsh0).Cells(i, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 6) <> Workbooks(wb).Worksheets(wsh0).Cells(i, 6) Then
             For iavl = derlavl To 2 Step -1
                 For j = 1 To 5000
                 If Workbooks(wb1).Worksheets(wsh0).Cells(i, j) <> "" Then
                  If LCase(ch_sans_accent(Workbooks(wb1).Worksheets(wsh0).Cells(i, 4))) = LCase(ch_sans_accent(Workbooks(wb).Worksheets(wsh).Cells(iavl, 3))) Then
                  Workbooks(wb).Worksheets(wsh0).Cells(i, j) = Workbooks(wb1).Worksheets(wsh0).Cells(i, j)
                  End If
                  End If
                 Next j
               Next iavl
            End If
            Next i
            
            For i3 = 2 To derlin
            last0 = Workbooks(wb).Worksheets(wsh0).Range("a" & i3).row + 1
            Next i3
            Application.StatusBar = "Fin de decalage"
            Application.StatusBar = "Importation de nouvelles activites"
            

ElseIf test0 < derlin Then
Application.StatusBar = "Decalage iOMEGA_1"

          For ii = derlin To 2 Step -1
             For i = derlin To 2 Step -1
             If Workbooks(wb).Worksheets(wsh0).Cells(ii, 1) <> "" Then
              If Workbooks(wb1).Worksheets(wsh0).Cells(i, 1) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 5) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 6) = Workbooks(wb).Worksheets(wsh0).Cells(ii, 6) Then
                lig1 = Workbooks(wb1).Worksheets(wsh0).Cells(i, 1).row
                lig2 = Workbooks(wb).Worksheets(wsh0).Cells(ii, 1).row
                If lig1 > lig2 Then
                Workbooks(wb).Worksheets(wsh0).Rows(ii).Cut Workbooks(wb).Worksheets(wsh0).Rows(lig1)
                End If
              End If
              End If
              Next i
            Next ii

Application.StatusBar = "Importation de nouvelles activites iOMEGA_1"
           For i = derlin To 2 Step -1
           Workbooks(wb).Worksheets(wsh0).Cells(i, 40) = "OMEGA 1"
           'apres le decalage, importer les données rajoutées dans les fichier sources
           If Workbooks(wb1).Worksheets(wsh0).Cells(i, 1) <> Workbooks(wb).Worksheets(wsh0).Cells(i, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 5) <> Workbooks(wb).Worksheets(wsh0).Cells(i, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i, 6) <> Workbooks(wb).Worksheets(wsh0).Cells(i, 6) Then
             For iavl = derlavl To 2 Step -1
                 For j = 1 To 5000
                 If Workbooks(wb1).Worksheets(wsh0).Cells(i, j) <> "" Then
                  If LCase(ch_sans_accent(Workbooks(wb1).Worksheets(wsh0).Cells(i, 4))) = LCase(ch_sans_accent(Workbooks(wb).Worksheets(wsh).Cells(iavl, 3))) Then
                  Workbooks(wb).Worksheets(wsh0).Cells(i, j) = Workbooks(wb1).Worksheets(wsh0).Cells(i, j)
                  End If
                  End If
                 Next j
               Next iavl
            End If
            Next i
            
            For i3 = 2 To derlin
            last0 = Workbooks(wb).Worksheets(wsh0).Range("a" & i3).row + 1
            Next i3
Application.StatusBar = "Fin d'importation iOMEGA_1"
ElseIf test0 > derlin Then ' si on a supprime des lignes dans la BDD source

For i4 = 2 To test0
Application.StatusBar = "Debut de Decalage iOMEGA_1"
            'decaler les données existantes deja en fonctio de numero de ligne de fichier sources
            For ii2 = 2 To test0
             If Workbooks(wb).Worksheets(wsh0).Cells(ii2, 1) <> "" Then
              If Workbooks(wb1).Worksheets(wsh0).Cells(i4, 1) = Workbooks(wb).Worksheets(wsh0).Cells(ii2, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i4, 5) = Workbooks(wb).Worksheets(wsh0).Cells(ii2, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i4, 6) = Workbooks(wb).Worksheets(wsh0).Cells(ii2, 6) Then
                lig1 = Workbooks(wb1).Worksheets(wsh0).Cells(i4, 1).row
                Workbooks(wb).Worksheets(wsh0).Rows(ii2).Cut Workbooks(wb).Worksheets(wsh0).Rows(lig1)
              End If
             End If
            Next ii2

Application.StatusBar = "Importation de nouvelles activites iOMEGA_1"
           'apres le decalage, importer les données rajoutées dans les fichier sources
            If Workbooks(wb1).Worksheets(wsh0).Cells(i4, 1) <> Workbooks(wb).Worksheets(wsh0).Cells(i4, 1) And Workbooks(wb1).Worksheets(wsh0).Cells(i4, 5) <> Workbooks(wb).Worksheets(wsh0).Cells(i4, 5) And Workbooks(wb1).Worksheets(wsh0).Cells(i4, 6) <> Workbooks(wb).Worksheets(wsh0).Cells(i4, 6) Then
              For iavl = derlavl To 2 Step -1
                 For j = 1 To 5000
                 If Workbooks(wb1).Worksheets(wsh0).Cells(i4, j) <> "" Then
                  If LCase(ch_sans_accent(Workbooks(wb1).Worksheets(wsh0).Cells(i4, 4))) = LCase(ch_sans_accent(Workbooks(wb).Worksheets(wsh).Cells(iavl, 3))) Then
                  Workbooks(wb).Worksheets(wsh0).Cells(i4, j) = Workbooks(wb1).Worksheets(wsh0).Cells(i4, j)
                  End If
                  End If
                 Next j
               Next iavl
            End If
Next i4
            
            
            der = Workbooks(wb1).Worksheets(wsh0).Range("a65000").End(xlUp).row 'derniere ligne de la BDD imoga6
            For u = 2 To der
            Workbooks(wb).Worksheets(wsh0).Cells(u, 40) = "OMEGA 1"
            Next u
          
            prem = Workbooks(wb).Worksheets(wsh0).Range("an" & test0).End(xlDown).row
            w = prem - 1 - der
            Workbooks(wb).Worksheets(wsh0).Rows(der + 1).Resize(w).Delete
          
            For i5 = 2 To derlin ' definir la derniere ligne occupée par la BDD 1
            last0 = Workbooks(wb).Worksheets(wsh0).Range("a" & i5).row + 1
            Next i5
          
Application.StatusBar = "Fin d'importation iOMEGA_1"
End If
            

Else
    
  last0 = 2
End If
End If
Next f

Application.StatusBar = "mise a jour terminée pour iOMEGA_1"
End Sub

Code:
Sub feuil_macro_1()
Dim test2, test3, test4, test5, test6, test7, test8, test9, test10, test11 As Integer
wsh1 = Worksheets("NEW_VB_config").Range("o2") 'nom de la 1ere feuille
wsh2 = Worksheets("NEW_VB_config").Range("o3") 'nom de la 2eme feuille
wsh3 = Worksheets("NEW_VB_config").Range("o4") 'nom de la 3eme feuille
wsh4 = Worksheets("NEW_VB_config").Range("o5") 'nom de la 4eme feuille
wsh5 = Worksheets("NEW_VB_config").Range("o6") 'nom de la 5eme feuille
wsh6 = Worksheets("NEW_VB_config").Range("o7") 'nom de la 6eme feuille
wsh7 = Worksheets("NEW_VB_config").Range("o8") 'nom de la 7eme feuille
wsh8 = Worksheets("NEW_VB_config").Range("o9") 'nom de la 8eme feuille
wsh9 = Worksheets("NEW_VB_config").Range("o10") 'nom de la 9eme feuille
wsh10 = Worksheets("NEW_VB_config").Range("o11") 'nom de la 10eme feuille
wsh11 = Worksheets("NEW_VB_config").Range("o12") 'nom de la 11eme feuille

wb = ActiveWorkbook.Name
wsh = Workbooks(wb).Worksheets("NEW_VB_config").Range("o13")
wb1 = Workbooks(wb).Worksheets(wsh).Range("a2")

chemin_1 = Workbooks(wb).Worksheets(wsh).Range("a9")
'chemin
Chemin = chemin_1
 NomFichier = wb1
 Workbooks.Open Filename:=Chemin & NomFichier

Call Feuil_1(wsh1, test2, last1)
Call Feuil_1(wsh2, test3, last2)
Call Feuil_1(wsh3, test4, last3)
Call Feuil_1(wsh4, test5, last4)
Call Feuil_1(wsh5, test6, last5)
Call Feuil_1(wsh6, test7, last6)
Call Feuil_1(wsh7, test8, last7)
Call Feuil_1(wsh8, test9, last8)
Call Feuil_1(wsh9, test10, last9)
Call Feuil_1(wsh10, test11, last10)
Call Feuil_1(wsh11, test12, last11)


'Windows(wb1).Activate
'ActiveWorkbook.Close


End Sub

voici le code si ca peut vous donnér une idee

merci encore
 

Hasco

XLDnaute Barbatruc
Repose en paix
Re bonjour,

Avez-vous essayer de rajouter l'instruction donnée en post #1 ?
VB:
Application.DisplayAlerts = False
workbooks.Open Filename:=Chemin & NomFichier
Application.DisplayAlerts = True

bonne soirée
 

BIL boud

XLDnaute Occasionnel
Re
oui jai essayer mais sans succes

voici c qui jai fiat

VB:
Sub feuil_macro_1()
Dim test2, test3, test4, test5, test6, test7, test8, test9, test10, test11 As Integer
wsh1 = Worksheets("NEW_VB_config").Range("o2") 'nom de la 1ere feuille
wsh2 = Worksheets("NEW_VB_config").Range("o3") 'nom de la 2eme feuille
wsh3 = Worksheets("NEW_VB_config").Range("o4") 'nom de la 3eme feuille
wsh4 = Worksheets("NEW_VB_config").Range("o5") 'nom de la 4eme feuille
wsh5 = Worksheets("NEW_VB_config").Range("o6") 'nom de la 5eme feuille
wsh6 = Worksheets("NEW_VB_config").Range("o7") 'nom de la 6eme feuille
wsh7 = Worksheets("NEW_VB_config").Range("o8") 'nom de la 7eme feuille
wsh8 = Worksheets("NEW_VB_config").Range("o9") 'nom de la 8eme feuille
wsh9 = Worksheets("NEW_VB_config").Range("o10") 'nom de la 9eme feuille
wsh10 = Worksheets("NEW_VB_config").Range("o11") 'nom de la 10eme feuille
wsh11 = Worksheets("NEW_VB_config").Range("o12") 'nom de la 11eme feuille

wb = ActiveWorkbook.Name
wsh = Workbooks(wb).Worksheets("NEW_VB_config").Range("o13")
wb1 = Workbooks(wb).Worksheets(wsh).Range("a2")


chemin_1 = Workbooks(wb).Worksheets(wsh).Range("a9")
'chemin
Chemin = chemin_1
 NomFichier = wb1
 Workbooks(wb1).Application.DisplayAlerts = False
 Workbooks.Open Filename:=Chemin & NomFichier




Call Feuil_1(wsh1, test2, last1)
Call Feuil_1(wsh2, test3, last2)
Call Feuil_1(wsh3, test4, last3)
Call Feuil_1(wsh4, test5, last4)
Call Feuil_1(wsh5, test6, last5)
Call Feuil_1(wsh6, test7, last6)
Call Feuil_1(wsh7, test8, last7)
Call Feuil_1(wsh8, test9, last8)
Call Feuil_1(wsh9, test10, last9)
Call Feuil_1(wsh10, test11, last10)
Call Feuil_1(wsh11, test12, last11)

Workbooks(wb1).Application.DisplayAlerts = True
 

BIL boud

XLDnaute Occasionnel
BONJOUR
jai essayer maius ca na ps macher

merci pour vos reponse

jai trouve un code qui desactive les macros mais je ne sais pas comment les activer avanr de fermer le classeur
si vous avez une idee je vous remercie de maider

voici le code qui desactive les macros
VB:
Workbooks(wb1).Application.AutomationSecurity = msoAutomationSecurityForceDisable
merci encore
 

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

Avant de désactiver la sécurité, mettre les paramètres actuels en variable:
VB:
Dim Securité As MsoAutomationSecurity
Securité = Application.AutomationSecurity

Puis en fin de travail rétablir les paramètres
Code:
Application.AutomationSecurity = Sécurité

P.S. vous n'êtes pas obligé de mettre
Workbooks(wb1).Application.AutomationSecurity si la macro tourne sous excel, un simple Application.AutomationSecurity suffit.




Bonne journée
 

BIL boud

XLDnaute Occasionnel
Bonjour,

Avant de désactiver la sécurité, mettre les paramètres actuels en variable:
VB:
Dim Securité As MsoAutomationSecurity
Securité = Application.AutomationSecurity

Puis en fin de travail rétablir les paramètres
Code:
Application.AutomationSecurity = Sécurité

P.S. vous n'êtes pas obligé de mettre
Workbooks(wb1).Application.AutomationSecurity si la macro tourne sous excel, un simple Application.AutomationSecurity suffit.




Bonne journée
merci pour les reponses
excellente journnée
 

Discussions similaires

Statistiques des forums

Discussions
311 707
Messages
2 081 734
Membres
101 809
dernier inscrit
HADER2024