Copia il codice VBA da un foglio in una cartella di lavoro a un’altra?

Ho usato le linee qui sotto per compilare i moduli VBA da una cartella di lavoro a un’altra e non so se c’è un modo più semplice, ma hanno funzionato bene:

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 

Tuttavia ora ho bisogno di copiare il codice VBA che si trova in un foglio, non in un modulo. Il metodo sopra non funziona per quello scenario.

Quale codice posso utilizzare per copiare il codice VBA in un foglio da una cartella di lavoro a un’altra?

Non è ansible rimuovere e reimportare VBComponent , poiché ciò eliminerebbe logicamente l’intero foglio di lavoro. Invece devi usare CodeModule per manipolare il testo all’interno del componente:

 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) 

Se qualcun altro atterra qui alla ricerca di un equivalente VSTO della risposta di Chel, eccolo qui:

 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]); } 

Cose da notare:

  1. È necessario aggiungere un riferimento a Microsoft.Vbe.Interop per eseguire questa operazione.
  2. Sto aggiungendo un nuovo modulo generale alla cartella di lavoro di destinazione, quindi non ho bisogno di chiamare DeleteLines . YMMV.

Questo è un codice compilato da diverse fonti e da questo stesso post. Il mio contributo è un codice che copia TUTTI i tuoi codici da VBE (Fogli / Questo libro di lavoro / Userform / Moduli / Classi) in una nuova cartella di lavoro.

Ho creato questo, perché ho una cartella di lavoro corrotta e fare un codice per recuperare tutto ciò che non è corrotto, incluso il codice. (questa parte recupera solo codice + riferimenti):

 '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