laurent950
XLDnaute Barbatruc
Bonsoir,
J’ai une problématique avec les variables et leurs portabilités.
Je m’explique :
J’ai deux dossiers :
1 – DossierSource (Avec les fichiers dont les informations doivent être extraites)
2 – DossierDestination (Vides)
Dans le DossierSource, je dois récupérer les feuilles onglets « Dupliquer » (de chacun des fichiers)
Dans le DossierDestination, je dois crée un classeur et copier la feuille (onglets « Dupliquer » de ce classeur) et lors de l’enregistrement (ce classeur doit avoir le même nom que le classeur ou à était récupéré les informations)
‘ - - - - - - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - -
La macro Fonctionne, mais j’aimerais la paramétré avec des variables objet pour :
Car je dois aussi récupérer les Fichiers portant l’extension .bas et .frm
‘ - - - - - - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - -
‘ C’est peux être pas bon ? la macro semelle ?
‘ - - - - - - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - -
J’ai vu que l’on peut faire comme cela mais je ne comprends pas tous ?
Set Wbk = ActiveWorkbook
tmpBas1 = "c:\ DupliquerTest001.bas"
ThisWorkbook.VBProject.VBComponents("DupliquerTest001").Export tmpBas1
Wbk.VBProject.VBComponents.Import tmpBas1
Kill tmpBas1
Je pense que mon système de recherche avec l’explorateur n’est pas très propre ?
Cela doit être noté une fois et cela est en double dans la macro
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Je joins la Macro dans le fichier : BoucleTransfertFeuilleModule
Le DossierSource (Avec les classeurs et feuilles qui ont des module VBA)
Le DossierDestination (Ou son crée les classeurs avec la feuille (Dupliquer) uniquement
Voici la macro VBA (Excel qui Transfert que les de feuilles pour le moment sans les module VBA « .bas » et « .frm »
Sub BoucleDouvertureRepertoire()
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Ouverture de L'explorateur de fichier (Pour les fichiers du répertoire Sources)
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Boucle d'ouverture
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim CheminSource As String
Set objShell = CreateObject("Shell.Application")
MsgBox "Choisir le repertoir Source ou seront faite les copies"
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
CheminSource = oFolderItem.Path
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Mémorisation du CheminSource et FichSource
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'MsgBox Chemin
CheminSource = CheminSource + "\"
'MsgBox Chemin
FichSource = Dir(CheminSource & "*.xlsm")
'MsgBox fich
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Ouverture de L'explorateur de fichier (Pour les fichiers du répertoire Destination)
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Boucle d'ouverture
Dim CheminDestination As String
Set objShell = CreateObject("Shell.Application")
MsgBox "Choisir le repertoir De Destination ou seront Crée les classeurs avec feuilles et module selectionnées"
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
CheminDestination = oFolderItem.Path
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Mémorisation du CheminDestination
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'MsgBox Chemin
CheminDestination = CheminDestination + "\"
'MsgBox Chemin
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Depart de la boucle qui effectura l'opération sous cette boucle tant qu'il y aura des fichier dans le repertoir
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Boucle
Do While FichSource <> ""
'Basculer sur le fichires source (Ouverture du premier fichier)
Workbooks.Open CheminSource & FichSource
'copier la feuille selectionné dans un nouveau classeur
Sheets("Dupliquer").Copy
' Fermeture du classeur ou les selections ont était faite (Feuilles, Module, usurforme etc.)
Workbooks(FichSource).Close
' Juste le nom du fichier source sans sont extention afin de le renomer exactement pareilles que sont
' fichier sources d'ou proviennent les différentes informations tiré de ce classeur
Extension = Len(FichSource) - 5 ' len = longueur du nom du fichier et - 5 = l'extention .xlsm (donc seul le nom du fichier)
FichSource = Left(FichSource, Extension) ' Gauche de l'extreme droite du nom - 5 caractéres (l'extension) = (donc seul le nom du fichier)
'MsgBox fich
' Enregitrement du document crée !
' CheminDestination = le répertoire choisie en deuxiemme passage
' FichSource = même non de classeur que celuis déja ouvert
' FileFormat:=xlOpenXMLWorkbookMacroEnabled = Pour enregistrer sous .xlsm (Classeur prenant en charge les macro)
ActiveWorkbook.SaveAs CheminDestination & FichSource, FileFormat:=xlOpenXMLWorkbookMacroEnabled
' Fermeture du fichier (enregistré)
ActiveWorkbook.Close False
' Fin de la boucle
FichSource = Dir ' (Boucle de redirection vers l'autres fichier du repertoire)
Loop
End Sub
Je vous remercie par avance si vous avez une solution plus simple
Laurent
J’ai une problématique avec les variables et leurs portabilités.
Je m’explique :
J’ai deux dossiers :
1 – DossierSource (Avec les fichiers dont les informations doivent être extraites)
2 – DossierDestination (Vides)
Dans le DossierSource, je dois récupérer les feuilles onglets « Dupliquer » (de chacun des fichiers)
Dans le DossierDestination, je dois crée un classeur et copier la feuille (onglets « Dupliquer » de ce classeur) et lors de l’enregistrement (ce classeur doit avoir le même nom que le classeur ou à était récupéré les informations)
‘ - - - - - - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - -
La macro Fonctionne, mais j’aimerais la paramétré avec des variables objet pour :
Car je dois aussi récupérer les Fichiers portant l’extension .bas et .frm
‘ - - - - - - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - -
‘ C’est peux être pas bon ? la macro semelle ?
‘ - - - - - - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - - -- - -
J’ai vu que l’on peut faire comme cela mais je ne comprends pas tous ?
Set Wbk = ActiveWorkbook
tmpBas1 = "c:\ DupliquerTest001.bas"
ThisWorkbook.VBProject.VBComponents("DupliquerTest001").Export tmpBas1
Wbk.VBProject.VBComponents.Import tmpBas1
Kill tmpBas1
Je pense que mon système de recherche avec l’explorateur n’est pas très propre ?
Cela doit être noté une fois et cela est en double dans la macro
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Je joins la Macro dans le fichier : BoucleTransfertFeuilleModule
Le DossierSource (Avec les classeurs et feuilles qui ont des module VBA)
Le DossierDestination (Ou son crée les classeurs avec la feuille (Dupliquer) uniquement
Voici la macro VBA (Excel qui Transfert que les de feuilles pour le moment sans les module VBA « .bas » et « .frm »
Sub BoucleDouvertureRepertoire()
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Ouverture de L'explorateur de fichier (Pour les fichiers du répertoire Sources)
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Boucle d'ouverture
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim CheminSource As String
Set objShell = CreateObject("Shell.Application")
MsgBox "Choisir le repertoir Source ou seront faite les copies"
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
CheminSource = oFolderItem.Path
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Mémorisation du CheminSource et FichSource
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'MsgBox Chemin
CheminSource = CheminSource + "\"
'MsgBox Chemin
FichSource = Dir(CheminSource & "*.xlsm")
'MsgBox fich
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Ouverture de L'explorateur de fichier (Pour les fichiers du répertoire Destination)
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Boucle d'ouverture
Dim CheminDestination As String
Set objShell = CreateObject("Shell.Application")
MsgBox "Choisir le repertoir De Destination ou seront Crée les classeurs avec feuilles et module selectionnées"
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
CheminDestination = oFolderItem.Path
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Mémorisation du CheminDestination
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'MsgBox Chemin
CheminDestination = CheminDestination + "\"
'MsgBox Chemin
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Depart de la boucle qui effectura l'opération sous cette boucle tant qu'il y aura des fichier dans le repertoir
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Boucle
Do While FichSource <> ""
'Basculer sur le fichires source (Ouverture du premier fichier)
Workbooks.Open CheminSource & FichSource
'copier la feuille selectionné dans un nouveau classeur
Sheets("Dupliquer").Copy
' Fermeture du classeur ou les selections ont était faite (Feuilles, Module, usurforme etc.)
Workbooks(FichSource).Close
' Juste le nom du fichier source sans sont extention afin de le renomer exactement pareilles que sont
' fichier sources d'ou proviennent les différentes informations tiré de ce classeur
Extension = Len(FichSource) - 5 ' len = longueur du nom du fichier et - 5 = l'extention .xlsm (donc seul le nom du fichier)
FichSource = Left(FichSource, Extension) ' Gauche de l'extreme droite du nom - 5 caractéres (l'extension) = (donc seul le nom du fichier)
'MsgBox fich
' Enregitrement du document crée !
' CheminDestination = le répertoire choisie en deuxiemme passage
' FichSource = même non de classeur que celuis déja ouvert
' FileFormat:=xlOpenXMLWorkbookMacroEnabled = Pour enregistrer sous .xlsm (Classeur prenant en charge les macro)
ActiveWorkbook.SaveAs CheminDestination & FichSource, FileFormat:=xlOpenXMLWorkbookMacroEnabled
' Fermeture du fichier (enregistré)
ActiveWorkbook.Close False
' Fin de la boucle
FichSource = Dir ' (Boucle de redirection vers l'autres fichier du repertoire)
Loop
End Sub
Je vous remercie par avance si vous avez une solution plus simple
Laurent
Dernière édition: