Copier le code VBA d'une feuille dans un classeur vers une autre?
j'ai utilisé les lignes ci-dessous pour compier les modules VBA d'un classeur à l'autre et je ne sais pas s'il y a un moyen plus simple, mais ils ont bien fonctionné:
Set srcVba = srcWbk.VBProject
Set srcModule = srcVba.VBComponents(moduleName)
srcModule.Export (path) 'Export from source
trgtVba.VBComponents.Remove VBComponent:=trgtVba.VBComponents.Item(moduleName) 'Remove from target
trgtVba.VBComponents.Import (path) 'Import to target
cependant maintenant je dois copier le code VBA qui est dans une feuille, pas dans un Module. La méthode ci-dessus ne fonctionne pas pour ce scénario.
quel code puis-je utiliser pour copier le code VBA dans une feuille d'un classeur à un autre?
3 réponses
vous ne pouvez pas supprimer et réimporter le VBComponent, puisque cela supprimerait logiquement toute la feuille de travail. Au lieu de cela, vous devez utiliser CodeModule pour manipuler le texte dans le composant de:
Dim src As CodeModule, dest As CodeModule
Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set dest = Workbooks("Book3").VBProject.VBComponents("ThisWorkbook") _
.CodeModule
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
si quelqu'un d'autre atterrit ici à la recherche de L'équivalent VSTO de la réponse de Chel, voici:
void CopyMacros(Workbook src, Workbook dest)
{
var srcModule = src.VBProject.VBComponents.Item(1).CodeModule;
var destModule = dest.VBProject.VBComponents.Add(Microsoft.Vbe.Interop.vbext_ComponentType.vbext_ct_StdModule);
destModule.CodeModule.AddFromString(srcModule.Lines[1, srcModule.CountOfLines]);
}
remarques:
- Vous devez ajouter une référence à Microsoft.Vbe.Interop pour faire ce genre de choses.
- j'ajoute un nouveau module général au classeur destination, donc je n'ai pas eu besoin d'appeler
DeleteLines. YMMV.
c'est un code compilé à partir de différentes sources ainsi que de ce Très un Post. Ma contribution est un code qui copie tous vos codes de VBE (Sheets/Thisworkbook/Userforms/Modules/Classes) vers un nouveau classeur.
j'ai créé ceci , parce que j'ai un classeur corrompu et faire un code pour récupérer tout ce qui n'est pas corrompu, y compris le code. (cette partie ne récupère code + références) :
'needs a reference to : Visual basic for Application Extensibility 5.3 ,
'or run this code : thisworkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
'from immediate window (ctrl+G) or create a small sub
Option Explicit
Sub CopyComponentsModules() 'copies sheets/Thisworkbook/Userforms/Modules/Classes to a new workbook
Dim src As CodeModule, dest As CodeModule
Dim i&
Dim WB_Dest As Workbook
'Dim sh As Worksheet
Dim Comp As VBComponent
'Set sh = ThisWorkbook.Sheets(1)
'sh.Cells.Clear
Set WB_Dest = Application.Workbooks.Add
On Error Resume Next 'needed for testing if component already exists in destination WorkBook and for cross-references.
For Each Comp In ThisWorkbook.VBProject.VBComponents
'i = i + 1
'sh.Cells(i, 1).Value = Comp.Name
'Set Source code module
Set src = Comp.CodeModule 'ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
'test if destination component exists first
i = 0: i = Len(WB_Dest.VBProject.VBComponents(Comp.Name).Name)
If i <> 0 Then 'or: if err=0 then
Set dest = WB_Dest.VBProject.VBComponents(Comp.Name).CodeModule
Else 'create component
With WB_Dest.VBProject.VBComponents.Add(Comp.Type)
.Name = Comp.Name
Set dest = .CodeModule
End With
End If
'copy module/Form/Sheet/Class 's code:
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
Next Comp
'Add references as well :
Dim Ref As Reference
For Each Ref In ThisWorkbook.VBProject.References
'Debug.Print Ref.Name 'Nom
WB_Dest.VBProject.References.AddFromFile Ref.FullPath
'Debug.Print Ref.FullPath 'Chemin complet
'Debug.Print Ref.Description 'Description de la référence
'Debug.Print Ref.IsBroken 'Indique si la référence est manquante
'Debug.Print Ref.Major & "." & Ref.Minor 'Version
'Debug.Print "---"
Next Ref
Err.Clear: On Error GoTo 0
'WB_Dest.Activate
Set Ref = Nothing
Set src = Nothing
Set dest = Nothing
Set Comp = Nothing
Set WB_Dest = Nothing
End Sub