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