XL 2019 Importer plusieurs userform en une seule fois.

farid

XLDnaute Occasionnel
Bonjour, question, est ce possible de remplacer le ou les mêmes userform module dans plusieurs fichiers qui ont tous les mêmes modules/userform qui se trouvent dans le même dossier en 1 seule fois via une VBA.
Exemple, je souhaite remplacer tous les userform 1, voire userform2 + 1 module de plusieurs classeurs dans le même dossier.
Actuellement, je suis obligé d'ouvrir fichier par fichier, supprimer le ou les userform, voire des modules et ensuite importer les userform et module de remplacement , lorsque j'ai plus de 200 fichiers , ça fais long.
Merci
Farid
 
Solution
Bon d'après ce que je comprends ce code devrait vous satisfaire, fichier (3) :
VB:
Sub Copier_UserForms_Modules_ThisWorkbook()
Dim chemin$, fichier$, vbc As Object, i%, a$(), n%, code$, wb As Workbook, nom$, j
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Application.ScreenUpdating = False
'---crée les fichiers .frm et .frx---
Set vbc = ThisWorkbook.VBProject.VBComponents
For i = 1 To vbc.Count
    If vbc(i).Type <= 3 Then 's'il s'agit d'un UserForm ou d'un module
        ReDim Preserve a(2, n) 'base 0
        a(0, n) = vbc(i).Name 'mémorise le nom
        a(1, n) = chemin & n & ".frm"
        a(2, n) = chemin & n & ".frx"
        vbc(i).Export a(1, n) 'le fichier frx pour les...

job75

XLDnaute Barbatruc
Bonjour farid,

Téléchargez les fichiers joints dans le même dossier (le bureau) et voyez les divers UserForms.

Puis exécutez cette macro affectée au bouton du fichier Source(1).xlsm :
VB:
Sub Copier_UserForms()
Dim chemin$, fichier$, vbc As Object, i%, a$(), n%, wb As Workbook
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Application.ScreenUpdating = False
'---crée les fichiers .frm et .frx---
Set vbc = ThisWorkbook.VBProject.VBComponents
For i = 1 To vbc.Count
    If vbc(i).Type = 3 Then 's'il s'agit d'un UserForm
        ReDim Preserve a(1, n) 'base 0
        a(0, n) = chemin & n & ".frm"
        a(1, n) = chemin & n & ".frx"
        vbc(i).Export chemin & n & ".frm" 'le fichier frx se crée en même temps
        n = n + 1
    End If
Next i
'---importe les fichiers .frm---
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then 'sauf le fichier source
        Set wb = Workbooks.Open(chemin & fichier)
        Set vbc = wb.VBProject.VBComponents
        For i = vbc.Count To 1 Step -1
            If vbc(i).Type = 3 Then vbc.Remove vbc(i) 'supprime les UserForms existants
        Next i
        For i = 0 To n - 1
            vbc.Import a(0, i)
        Next i
        wb.Close True 'enregistre et ferme le fichier
    End If
    fichier = Dir 'fichier suivant
Wend
'---supprime les fichiers .frm et .frx---
For i = 0 To n - 1
    Kill a(0, i)
    Kill a(1, i)
Next i
End Sub
Pour que l'accès au VBAProject soit possible 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).

Edit : mots clés VBA Copier UserForm ou VBA Dupliquer UserForm.

A+
 

Pièces jointes

  • Source(1).xlsm
    23.7 KB · Affichages: 13
  • Destination1.xlsm
    12.3 KB · Affichages: 17
  • Destination2.xlsm
    12.3 KB · Affichages: 18
Dernière édition:

farid

XLDnaute Occasionnel
J'ai ajouté une boucle pour simuler la duplication des 2 UserForms vers 200 fichiers.

Chez moi sur Excel 2019 la macro s'exécute en 71 secondes.

C'est l'enregistrement qui prend du temps.
Bonjour Job
Merci pour ce retour et qui fonctionne très bien pour les userform, je viens de faire les tests et c'est nickel. Est ce possible que l'on puisse intégrer aussi les modules et voir même le ThisWorkbook.
Tu n'as pas idée à quel point que cela va accélérer mes projets.
Par avance merci
 

job75

XLDnaute Barbatruc
Tu n'as pas idée à quel point que cela va accélérer mes projets.
Oh si j'ai idée :eek:

Que voulez-vous dire par intégrer les modules et le ThisWorkbook ? Tout copier ?

Dans ce cas c'est très simple :
VB:
Sub Copier_tout()
Dim chemin$, fichier$, fso As Object, fn$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
fn = ThisWorkbook.FullName
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then fso.Copyfile fn, chemin & fichier
    fichier = Dir 'fichier suivant
Wend
End Sub
 

Pièces jointes

  • Source(2).xlsm
    23.1 KB · Affichages: 6
  • Destination1.xlsm
    12.3 KB · Affichages: 3
  • Destination2.xlsm
    12.3 KB · Affichages: 5

farid

XLDnaute Occasionnel
Oh si j'ai idée :eek:

Que voulez-vous dire par intégrer les modules et le ThisWorkbook ? Tout copier ?

Dans ce cas c'est très simple :
VB:
Sub Copier_tout()
Dim chemin$, fichier$, fso As Object, fn$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
fn = ThisWorkbook.FullName
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then fso.Copyfile fn, chemin & fichier
    fichier = Dir 'fichier suivant
Wend
End Sub
Merci beaucoup, je teste et je reviens vers vous en vous souhaitant une bonne soirée.
Bien cordialement
 

farid

XLDnaute Occasionnel
Oh si j'ai idée :eek:

Que voulez-vous dire par intégrer les modules et le ThisWorkbook ? Tout copier ?

Dans ce cas c'est très simple :
VB:
Sub Copier_tout()
Dim chemin$, fichier$, fso As Object, fn$
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Set fso = CreateObject("Scripting.FileSystemObject")
fn = ThisWorkbook.FullName
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then fso.Copyfile fn, chemin & fichier
    fichier = Dir 'fichier suivant
Wend
End Sub
Bonjour Job, je viens de tester votre proposition qui fonctionne très bien, cependant pour 2 choses :
- est-ce possible que le remplacement des feuilles ne soient pris en compte, car sur les feuilles concernées, ils ont déjà des saisies effectuées.
- Est possible que seuls les userform/modules/ et les lignes de commande dans le ThisWorkbook du fichier source remplacent uniquement ceux des fichiers de destinations sans toucher aux autres userform ou modules des fichiers de destinations.
J'espère que je me suis fait comprendre.
Merci par avance
cordialement et bonne journée
Farid
 

job75

XLDnaute Barbatruc
Bon d'après ce que je comprends ce code devrait vous satisfaire, fichier (3) :
VB:
Sub Copier_UserForms_Modules_ThisWorkbook()
Dim chemin$, fichier$, vbc As Object, i%, a$(), n%, code$, wb As Workbook, nom$, j
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Application.ScreenUpdating = False
'---crée les fichiers .frm et .frx---
Set vbc = ThisWorkbook.VBProject.VBComponents
For i = 1 To vbc.Count
    If vbc(i).Type <= 3 Then 's'il s'agit d'un UserForm ou d'un module
        ReDim Preserve a(2, n) 'base 0
        a(0, n) = vbc(i).Name 'mémorise le nom
        a(1, n) = chemin & n & ".frm"
        a(2, n) = chemin & n & ".frx"
        vbc(i).Export a(1, n) 'le fichier frx pour les UserForms se crée en même temps
        n = n + 1
    End If
Next i
'---code du ThisWorkbook---
With vbc(ThisWorkbook.CodeName).CodeModule
    code = .Lines(1, .CountOfLines)
End With
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then 'sauf le fichier source
        Application.EnableEvents = False 'désactive les évènements (Workbook_Open)
        Set wb = Workbooks.Open(chemin & fichier)
        Application.EnableEvents = True 'réactive les évènements
        Set vbc = wb.VBProject.VBComponents
        '---importe les fichiers .frm---
        For i = 0 To n - 1
            nom = LCase(a(0, i))
            For j = 1 To vbc.Count
                If vbc(j).Type <= 3 Then If LCase(vbc(j).Name) = nom Then vbc.Remove vbc(j): Exit For 'supprime l'élément de même nom s'il existe
            Next j
            vbc.Import a(1, i)
        Next i
        '---importe le code du ThisWorkbook---
        With vbc(wb.CodeName).CodeModule
            .DeleteLines 1, .CountOfLines 'RAZ
            .InsertLines 1, code
        End With
        '---enregistre et ferme le fichier---
        wb.Close True
    End If
    fichier = Dir 'fichier suivant
Wend
'---supprime les fichiers .frm et .frx---
For i = 0 To n - 1
    Kill a(1, i)
    If Dir(a(2, i)) <> "" Then Kill a(2, i)
Next i
End Sub
Seul l'élément portant le nom de celui qui est importé est supprimé avant l'import.

Et le code du ThisWorkbook est importé.

Edit : j'utilise ThisWorkbook.CodeName et wb.CodeName au cas où les noms des ThisWorkbook seraient modifiés.
 

Pièces jointes

  • Source(3).xlsm
    24.9 KB · Affichages: 12
  • Destination1.xlsm
    12.3 KB · Affichages: 8
  • Destination2.xlsm
    12.3 KB · Affichages: 7
Dernière édition:

farid

XLDnaute Occasionnel
Bon d'après ce que je comprends ce code devrait vous satisfaire, fichier (3) :
VB:
Sub Copier_UserForms_Modules_ThisWorkbook()
Dim chemin$, fichier$, vbc As Object, i%, a$(), n%, code$, wb As Workbook, nom$, j
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Application.ScreenUpdating = False
'---crée les fichiers .frm et .frx---
Set vbc = ThisWorkbook.VBProject.VBComponents
For i = 1 To vbc.Count
    If vbc(i).Type <= 3 Then 's'il s'agit d'un UserForm ou d'un module
        ReDim Preserve a(2, n) 'base 0
        a(0, n) = vbc(i).Name 'mémorise le nom
        a(1, n) = chemin & n & ".frm"
        a(2, n) = chemin & n & ".frx"
        vbc(i).Export a(1, n) 'le fichier frx pour les UserForms se crée en même temps
        n = n + 1
    End If
Next i
'---code du ThisWorkbook---
With vbc(ThisWorkbook.CodeName).CodeModule
    code = .Lines(1, .CountOfLines)
End With
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then 'sauf le fichier source
        Application.EnableEvents = False 'désactive les évènements (Workbook_Open)
        Set wb = Workbooks.Open(chemin & fichier)
        Application.EnableEvents = True 'réactive les évènements
        Set vbc = wb.VBProject.VBComponents
        '---importe les fichiers .frm---
        For i = 0 To n - 1
            nom = LCase(a(0, i))
            For j = 1 To vbc.Count
                If vbc(j).Type <= 3 Then If LCase(vbc(j).Name) = nom Then vbc.Remove vbc(j): Exit For 'supprime l'élément de même nom s'il existe
            Next j
            vbc.Import a(1, i)
        Next i
        '---importe le code du ThisWorkbook---
        With vbc(wb.CodeName).CodeModule
            .DeleteLines 1, .CountOfLines 'RAZ
            .InsertLines 1, code
        End With
        '---enregistre et ferme le fichier---
        wb.Close True
    End If
    fichier = Dir 'fichier suivant
Wend
'---supprime les fichiers .frm et .frx---
For i = 0 To n - 1
    Kill a(1, i)
    If Dir(a(2, i)) <> "" Then Kill a(2, i)
Next i
End Sub
Seul l'élément portant le nom de celui qui est importé est supprimé avant l'import.

Et le code du ThisWorkbook est importé.

Edit : j'utilise ThisWorkbook.CodeName et wb.CodeName au cas où les noms des ThisWorkbook seraient modifiés.
Bonjour Job, désolé j'étais en déplacement vers ma Normandie.Je regarde et je reveins vers vous
encore merci .
 

farid

XLDnaute Occasionnel
Bon d'après ce que je comprends ce code devrait vous satisfaire, fichier (3) :
VB:
Sub Copier_UserForms_Modules_ThisWorkbook()
Dim chemin$, fichier$, vbc As Object, i%, a$(), n%, code$, wb As Workbook, nom$, j
chemin = ThisWorkbook.Path & "\"
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier'à adapter
Application.ScreenUpdating = False
'---crée les fichiers .frm et .frx---
Set vbc = ThisWorkbook.VBProject.VBComponents
For i = 1 To vbc.Count
    If vbc(i).Type <= 3 Then 's'il s'agit d'un UserForm ou d'un module
        ReDim Preserve a(2, n) 'base 0
        a(0, n) = vbc(i).Name 'mémorise le nom
        a(1, n) = chemin & n & ".frm"
        a(2, n) = chemin & n & ".frx"
        vbc(i).Export a(1, n) 'le fichier frx pour les UserForms se crée en même temps
        n = n + 1
    End If
Next i
'---code du ThisWorkbook---
With vbc(ThisWorkbook.CodeName).CodeModule
    code = .Lines(1, .CountOfLines)
End With
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then 'sauf le fichier source
        Application.EnableEvents = False 'désactive les évènements (Workbook_Open)
        Set wb = Workbooks.Open(chemin & fichier)
        Application.EnableEvents = True 'réactive les évènements
        Set vbc = wb.VBProject.VBComponents
        '---importe les fichiers .frm---
        For i = 0 To n - 1
            nom = LCase(a(0, i))
            For j = 1 To vbc.Count
                If vbc(j).Type <= 3 Then If LCase(vbc(j).Name) = nom Then vbc.Remove vbc(j): Exit For 'supprime l'élément de même nom s'il existe
            Next j
            vbc.Import a(1, i)
        Next i
        '---importe le code du ThisWorkbook---
        With vbc(wb.CodeName).CodeModule
            .DeleteLines 1, .CountOfLines 'RAZ
            .InsertLines 1, code
        End With
        '---enregistre et ferme le fichier---
        wb.Close True
    End If
    fichier = Dir 'fichier suivant
Wend
'---supprime les fichiers .frm et .frx---
For i = 0 To n - 1
    Kill a(1, i)
    If Dir(a(2, i)) <> "" Then Kill a(2, i)
Next i
End Sub
Seul l'élément portant le nom de celui qui est importé est supprimé avant l'import.

Et le code du ThisWorkbook est importé.

Edit : j'utilise ThisWorkbook.CodeName et wb.CodeName au cas où les noms des ThisWorkbook seraient modifiés.
Bonjour Job, je ne connais pas toutes les langues du monde, mais je tiens à vous remercier dans toutes ces langues et extraterrestres comprises. Je vais abuser de votre grande connaissance dans ce domaine.
Votre formule fonctionne très bien, cependant et si c'est possible, mes fichiers VBAProject sont protégés par MDP et votre formule fonctionne très bien des classeurs dont les VBA ne sont pas sous MDP.
La question est la suivante :
Est ce possible dans votre formule d'ajouter une ligne de commande qui permet de désactiver le mot de passe afin d'intégrer les userform/module... Selon votre code sans supprimer la protection lors de la fermeture du fichier de destination .
espère avoir été compris.
Par avance , merci
 

farid

XLDnaute Occasionnel
Bonjour farid,

Non, la protection du VBAProject ne peut pas être ôtée ou remise par macro.

A+
Merci beaucoup pour ce retour. Je m'en doutais à la lecture de différents échanges sur le web sur cette question.
Merci beaucoup pour tous, et s'il vous prenait de passer au puy de Dôme n'hésiter pas à le dire, ça sera avec plaisir de vous offrir un tour en train à crémaillère.
Au plaisir
Farid
 

farid

XLDnaute Occasionnel
Bonjour farid,

Non, la protection du VBAProject ne peut pas être ôtée ou remise par macro.

A+
Bonjour Job,

Je reviens vers vous concernant le dernier sujet de cette discussion, je vous rassure, votre macro fonctionne très bien et je m’en éclate.

Je voulais savoir, en restant sur le même raisonnement de votre macro, s’il y avait possibilité de pouvoir ajouter une option supplémentaire, à savoir :

  • Remplacer une feuille (« PARAM ») existante
  • Ou de copier la feuille du fichier source que j’appelle « PARAM » pour créer une copie dans les classeurs du même dossier.
Cette feuille me sert de base de données pour ma GMAO et j’aurai besoin d’apporter des modifications.

J’espère que ma demande est comprise et réalisable.
Est-ce que je dois ouvrir une nouvelle discussion ?
Par avance, merci et bonne journée.
 

Discussions similaires

Réponses
1
Affichages
373