Impossible d'importer un module en VBA

[Arpette]

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
@+

 

[Staple1600]

Bonsoir à tous

Bonsoir à toutes et à tous,
PS : je ne vois plus les balises

Pour infos, les balises sont les suivantes
[CODE=VB]
ici le code VBA
[/CODE]

 

[Arpette]

Merci Staple pour les balises, pour l'erreur une idée ?

j'ai un message d'erreur sur la ligne

Set VBProj = wb.VBProject

Erreur 1004 la méthode a échoué.

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

 

[job75]

Bonsoir Arpette, Jean-Marie,

Sur Excel 2007 et versions suivantes il faut avoir coché l'option Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

Donc à vérifier.

Bonne fin de soirée.

 

[Arpette]

Bonjour Job, merci c'était bien ça.
Maintenant je n'arrive pas à importer mon module fbas,, j'ai un message comme quoi il n'existe pas dans le chemin.

Application.VBE.ActiveVBProject.VBComponents.Import (fbas)

Merci de votre aide
@+

 

[Staple1600]

Bonjour à tous

arpette
pourquoi ne pas avoir "dimer" Rep?
Donc essaie d'ajouter
Dim Rep As String
Essaie aussi sans les parenthèses
Application.VBE.ActiveVBProject.VBComponents.Import fbas

 

[job75]

Bonjour Arpette, JM, le forum,

Au lieu d'utiliser un fichier .bas pourquoi ne pas copier le Module3 du fichier Excel ?

Sub CopierModule()
Dim chemin$, t$, fich$
chemin = ThisWorkbook.Path & "\"
With ThisWorkbook.VBProject.VBComponents("Module3").CodeModule
  t = .Lines(1, .CountOfLines) 'texte du code
End With
fich = Dir(chemin & "*.xls")
Application.ScreenUpdating = False
On Error Resume Next
While fich <> ""
  If fich <> ThisWorkbook.Name Then
    With Workbooks.Open(chemin & fich)
      With .VBProject
        .VBComponents.Remove .VBComponents("Module3")
        .VBComponents.Add(1).Name = "Module3"
        .VBComponents("Module3").CodeModule.AddFromString t
      End With
      .Close True
    End With
  End If
  fich = Dir
Wend
End Sub

Au départ seul Fichier(1) contient Module3.

Lancer la macro pour le copier dans les fichiers (2) et (3).

A+

 

[Arpette]

Bonjour à tous les deux,
Merci pour vos réponses, j'ai suivi le conseil de Staple voici ce que ça donne :

Sub imp_module()
Dim nf%, fbas$, f$
Dim wb As Workbook
Dim i&
Dim VBProj As Object
Dim oldMod As Object
Dim Rep As String

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 'supprime module3
  ActiveWorkbook.VBProject.VBComponents.Import fbas 'importe module3
  
  On Error GoTo 0
  Set VBProj = Nothing
  Set CodeMod = Nothing
  wb.Close True
  End If
  f = Dir()
Loop 'boucle sur les fichiers du répertoire

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Encore merci,
@+

 

[job75]

Bonjour Arpette, le forum,

Votre code manque de précision, vous l'avez bien testé ? Le module créé doit être renommé.

Si l'on tient à utiliser un fichier auxiliaire, un fichier texte .txt est plus facile à créer.

La macro pour créer Module3 :

Sub CopierModule()
Dim chemin$, fich$
chemin = ThisWorkbook.Path & "\"
fich = Dir(chemin & "*.xls")
Application.ScreenUpdating = False
On Error Resume Next
While fich <> ""
  If fich <> ThisWorkbook.Name Then
    With Workbooks.Open(chemin & fich)
      With .VBProject
        .VBComponents.Remove .VBComponents("Module3")
        .VBComponents.Import(chemin & "Module3.txt").Name = "Module3"
      End With
      .Close True
    End With
  End If
  fich = Dir
Wend
End Sub

Fichiers zippés joints, à extraire dans le même répertoire.

A+

 

[Arpette]

Bonsoir à toutes et à tous,
J'ai de nouveau une erreur 1004 dans mon code à la ligne

Set wb = Workbooks.Open(fich)

Option Explicit
Sub test()
Dim Fso As Object, MonRepertoire As String
Dim f1 As Object, f2 As Object
Dim chemin$, fich$
Dim wb As Workbook
Dim VBProj As Object
Dim oldMod As Object
Dim CodeMod As Object

Application.ScreenUpdating = False
Application.EnableEvents = False

Set Fso = CreateObject("Scripting.FileSystemObject")
chemin = "F:\Trames\CONTROLES CLIENTS\"

For Each f1 In Fso.GetFolder(chemin).SubFolders
  For Each f2 In f1.Files
fich = Dir(f2)
Do While fich <> "" 'boucle sur les fichiers du répertoire
  If fich <> "" Then
  Set wb = Workbooks.Open(chemin & fich)
  Set VBProj = wb.VBProject
  Set oldMod = ActiveWorkbook.VBProject.VBComponents("module3")
  ActiveWorkbook.VBProject.VBComponents.Remove oldMod 'supprime module3
  ActiveWorkbook.VBProject.VBComponents.Import(MonRepertoire & "Module3.txt").Name = "Module3" 'importe module3
  Set oldMod = ActiveWorkbook.VBProject.VBComponents("module2")
  ActiveWorkbook.VBProject.VBComponents.Remove oldMod 'supprime module2
  ActiveWorkbook.VBProject.VBComponents.Import(MonRepertoire & "Module2.txt").Name = "Module2" 'importe module2

  wb.Close True

  End If

  fich = Dir
Loop 'boucle sur les fichiers du répertoire
Next f2
Next f1
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[Staple1600]

Bonjour à tous

Normalement ça devrait être plutôt ceci, non ?
Set wb = Workbooks.Open(MonRepertoire & fich)

 

[Arpette]

Set wb = Workbooks.Open MonRepertoire & fich

 

[Arpette]

Bonsoir Stape,

j'ai toujours le même message. Il semblerait que cela vienne de la ligne

 fich = Dir(f2)

, si je la supprime le fichier s'ouvre.
Merci de ton aide
@+

 

[Staple1600]

Re à tous

Tu as essayé le code proposé par job75 dans le message#2 ?
NB:lui aussi ajoute le nom du répertoire pour ouvrir le classeur
With Workbooks.Open(chemin & fich)
(voir ma suggestion du message#11:Set wb = Workbooks.Open(MonRepertoire & fich)
PS: j'ai rajouté les () que j'avais précédemment oublié

EDITION: En plus tu utilisais déjà la bonne syntaxe dans ton premier message ???

Set wb = Workbooks.Open(Rep & f) 'ouvre le fichier

 

[Arpette]

Bonsoir à toutes et à tous,
impossible d'ouvrir le classeur erreur 1004.
A noter que par rapport à mon premier post, j'ai rajouté l'ouverture de sous répertoires.

Merci de votre aide
@+