Impossible d'importer un module en VBA

Arpette · 12 Août 2016

Bonsoir à toutes et à tous,
j'ai un message d'erreur sur la ligne #Set VBProj = wb.VBProject# Erreur 1004 la méthode a échoué.
PS : je ne vois plus les balises

Voici le code complet :
Sub imp_module()
Dim nf%, fbas$, f$
Dim wb As Workbook
Dim i&
Dim VBProj As Object
Dim oldMod As Object

Rep = "F:\Trames\Module\"
fbas = Rep & "Module3.bas"
Application.ScreenUpdating = False
Application.EnableEvents = False

f = Dir(Rep & "*.xls")
Do While f <> "" 'boucle sur les fichiers du répertoire
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(Rep & f) 'ouvre le fichier
Set VBProj = wb.VBProject
Set oldMod = ActiveWorkbook.VBProject.VBComponents("module3")
ActiveWorkbook.VBProject.VBComponents.Remove oldMod
Application.VBE.ActiveVBProject.VBComponents.Import (fbas)
On Error GoTo 0
Set VBProj = Nothing
Set CodeMod = Nothing
wb.Close True
End If
f = Dir()
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Merci de votre aide
@+

Arpette · 19 Septembre 2016

Les amis, pas d'idée ?

job75 · 19 Septembre 2016

Bonsoir Arpette,

Arpette à dit:
Les amis, pas d'idée ?

Je vous ai donné 2 solutions, toutes les 2 fonctionnent parfaitement.

Alors que vos codes ne tiennent pas la route.

A vous de choisir.

A+

job75 · 20 Septembre 2016

Bonjour Arpette, le forum,

Puisque vous voulez le FileSystemObject voici une 3ème solution :

Code:

Sub CopierModules()
Dim chemin$, fso As Object, sf As Object, f As Object
chemin = ThisWorkbook.Path & "\" '"F:\Trames\CONTROLES CLIENTS\"
Set fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
Application.EnableEvents = False 'si nécessaire
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  For Each f In sf.Files
    If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
      With Workbooks.Open(f.Path)
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(chemin & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(chemin & "Module3.txt").Name = "Module3"
        End With
        .Close True
      End With
    End If
Next f, sf
Application.EnableEvents = True
End Sub

Notez que f.Path donne le chemin d'accès suivi du nom du fichier.

Fichiers et les sous-dossiers zippés joints pour tester.

Bonne journée.

Arpette · 20 Septembre 2016

Bonjour Job, le forum,

Un grand merci pour ce code qui fonctionne à merveille.

Bonne journée.

job75 · 20 Septembre 2016

Re,

Bah en voulant trop simplifier le code j'ai fait une erreur, au lieu de :

Code:

        With .VBProject.VBComponents
          .Remove .VBComponents("Module2")
          .Import(chemin & "Module2.txt").Name = "Module2"
          .Remove .VBComponents("Module3")
          .Import(chemin & "Module3.txt").Name = "Module3"
        End With

il faut écrire :

Code:

        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(chemin & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(chemin & "Module3.txt").Name = "Module3"
        End With

Je corrige le post précédent, prenez la bonne macro.

A+

Arpette · 20 Septembre 2016

Re,
je viens de m'en apercevoir. Il y a un autre soucis, le code boucle bien sur f mais quand c'est terminé il ne remonte pas sur sf, il repart sur f.
Merci de votre aide,
@+

job75 · 20 Septembre 2016

Re,

Le code étudie tous les sous-dossiers sf et dans chacun d'eux tous les fichiers f.

Je ne vois pas ce que vous voulez dire, vous ne comprenez pas Next f, sf ?

C'est la même chose que :

Code:

  Next f
Next sf

A+

Arpette · 20 Septembre 2016

Re,
Oui je comprends bien, mais ce que je veux dire, sf est un dossier qui est dans le chemin et f est un sous dossier de sf dans lequel il y a les fichiers .xls. Dans votre exemple dossier 2 n'est pas un sous dossier de dossier 1 .
En tous les cas merci de votre aide,
@+

job75 · 20 Septembre 2016

Re,

Arpette à dit:
et f est un sous dossier de sf dans lequel il y a les fichiers .xls.

Pas du tout, f est un fichier quelconque, allez on tire l'échelle.

Bonne fin de soirée.

Arpette · 20 Septembre 2016

Bonne fin de soirée

job75 · 21 Septembre 2016

Bonjour Arpette, le forum,

J'ai vu que vous êtes déçu

Alors si vous voulez traiter toute l'arborescence des sous-dossiers il faut une récursivité :

Code:

Dim CheminInitial$, fso As Object 'mémorisation des variables

Sub CopierModules()
CheminInitial = ThisWorkbook.Path & "\" '"F:\Trames\CONTROLES CLIENTS\"
Set fso = CreateObject("Scripting.FileSystemObject")
Copie CheminInitial
End Sub

Sub Copie(chemin$)
Dim sf As Object, f As Object
Application.ScreenUpdating = False
Application.EnableEvents = False 'si nécessaire
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  Copie sf.Path 'récursivité pour traiter l'arborescence
  For Each f In sf.Files
    If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
      With Workbooks.Open(f.Path)
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(CheminInitial & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(CheminInitial & "Module3.txt").Name = "Module3"
        End With
        .Close True
      End With
    End If
Next f, sf
Application.EnableEvents = True
End Sub

Ci-joint les fichiers avec 4 sous-dossiers (8 fichiers étudiés).

Bonne journée.

Arpette · 21 Septembre 2016

Bonjour Job, le forum,
Un grand merci Job pour ce code. Cela répond exactement à ce que je voulais.
Bonne soirée à vous

@+

Arpette · 3 Octobre 2016

bonsoir Job, le forum,

Avec votre code j'ai pu modifier la totalité des fichiers (3506). j'essaie maintenant sur le même principe d'exécuter le module 3 sur tous les fichiers. J'ai écrit ceci mas cela ne fonctionne pas.

VB:

Option Explicit
Dim CheminInitial$, fso As Object 'mémorisation des variables

Sub CopierModules()
CheminInitial = ThisWorkbook.Path & "\" '"F:\Trames\CONTROLES CLIENTS\"
Set fso = CreateObject("Scripting.FileSystemObject")
Copie CheminInitial
End Sub

Sub Copie(chemin$)
Dim sf As Object, f As Object
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  Copie sf.Path 'récursivité pour traiter l'arborescence
  For Each f In sf.Files
  If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
  Application.ScreenUpdating = False
  Application.EnableEvents = False 'si nécessaire
  With Workbooks.Open(f.Path)
  With .VBProject
  .Application.Run "Module3"
  End With
  .Close True
  End With
  End If
Next f, sf
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Merci de votre aide

@+

job75 · 3 Octobre 2016

Bonsoir Arpette,

Là vous jouez les apprentis sorciers, un module ne s'exécute pas !!!

Si vous tenez absolument à exécuter l'une des macros (???) dans chaque fichier :

Code:

Sub Copie(chemin$)
Dim sf As Object, f As Object
Application.ScreenUpdating = False
Application.EnableEvents = False 'si nécessaire
On Error Resume Next
For Each sf In fso.GetFolder(chemin).SubFolders
  Copie sf.Path 'récursivité pour traiter l'arborescence
  For Each f In sf.Files
    If f.Name <> ThisWorkbook.Name And f.Name Like "*.xls" Then
      With Workbooks.Open(f.Path)
        With .VBProject
          .VBComponents.Remove .VBComponents("Module2")
          .VBComponents.Import(CheminInitial & "Module2.txt").Name = "Module2"
          .VBComponents.Remove .VBComponents("Module3")
          .VBComponents.Import(CheminInitial & "Module3.txt").Name = "Module3"
        End With
        Application.Run "'" & .Name & "'!Salut" '????????????????
        .Close True
      End With
    End If
Next f, sf
Application.EnableEvents = True
End Sub

Bonne nuit.

Arpette · 4 Octobre 2016

Bonjour Job, oui je veux exécuter le module 3 de tous les fichiers.
Par contre je ne pas exécuter cette partie du code car déjà fait

With .VBProject
.VBComponents.Remove .VBComponents("Module2")
.VBComponents.Import(CheminInitial & "Module2.txt").Name = "Module2"
.VBComponents.Remove .VBComponents("Module3")
.VBComponents.Import(CheminInitial & "Module3.txt").Name = "Module3"
End With

Merci de votre aide.

Impossible d'importer un module en VBA

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

Discussions similaires

Partager cette page

Statistiques des forums