web-dev-qa-db-fra.com

Copier le code VBA d’une feuille d’un classeur à un autre?

J'ai utilisé les lignes ci-dessous pour compiler des modules VBA d'un classeur à un autre et je ne sais pas s'il existe un moyen plus simple, mais ils fonctionnent bien:

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, je dois maintenant copier le code VBA qui se trouve dans une feuille et non 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 d'une feuille d'un classeur dans un autre?

vbaexcel-vbavbeexcel
15
user1283776

Vous ne pouvez pas supprimer et réimporter la VBComponent, car cela effacerait logiquement toute la feuille de calcul. A la place, vous devez utiliser CodeModule pour manipuler le texte dans le composant:

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)
28
Chel

Le code de Patrick ne fonctionne pas pour les feuilles de calcul (en fait, le code sera transféré au mauvais module). Une solution de contournement consiste à créer une nouvelle feuille dans le classeur de destination, puis à copier le code (vous pouvez également copier et coller les données/fonctions/formatage de la feuille de calcul).

L'autre chose qui ne fonctionne pas, c'est UserForms. Vous pouvez copier le code dessus, mais je ne connais aucun moyen de copier le formulaire réel (y compris tous les contrôles) sans utiliser la méthode d'exportation/importation.

Développer le code de Patrick:

'Needs reference to : Microsoft 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

' What works:   Successfully tranfsers Modules with code and name
'               Copies userform code and name only, but the form is blank (does not transfer controls)
'               Copies code in sheets but no content (optionally add code to copy & paste content)
'               Successfully transfers Classes with code and name

Option Explicit

Public 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 Ref As Reference
    Dim Comp As VBComponent
    Dim sht As Worksheet

    Debug.Print "Starting"

    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
            Debug.Print Comp.Name & " - "; Comp.Type
            Err.Clear
            '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
                Err.Clear
                If Comp.Type = 100 Then
                    Set sht = WB_Dest.Sheets.Add
                    Set dest = WB_Dest.VBProject.VBComponents(sht.Name).CodeModule
                    WB_Dest.VBProject.VBComponents(sht.Name).Name = Comp.Name
                    sht.Name = Comp.Name
                Else
                    With WB_Dest.VBProject.VBComponents.Add(Comp.Type)
                        If Err.Number <> 0 Then
                            MsgBox "Error: Component " & Comp.Name & vbCrLf & Err.Description
                        Else
                            .Name = Comp.Name
                            Set dest = .CodeModule
                        End If
                    End With
                End If
            End If

            If Err.Number = 0 Then
                'copy module/Form/Sheet/Class 's code:
                dest.DeleteLines 1, dest.CountOfLines
                dest.AddFromString src.Lines(1, src.CountOfLines)
            End If
        Next Comp

        'Add references as well :
        For Each Ref In ThisWorkbook.VBProject.References
            WB_Dest.VBProject.References.AddFromFile Ref.FullPath
        Next Ref

    Err.Clear: On Error GoTo 0

    Set Ref = Nothing
    Set src = Nothing
    Set dest = Nothing
    Set Comp = Nothing
    Set WB_Dest = Nothing
End Sub
1
Pete ACI

Si quelqu'un d'autre arrive ici en cherchant l'équivalent VSTO de la réponse de Chel, la 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]);
}

Choses à noter:

  1. Vous devez ajouter une référence à Microsoft.Vbe.Interop pour faire ce genre de choses.
  2. J'ajoute un nouveau module général au classeur de destination; je n'avais donc pas besoin d'appeler DeleteLines. YMMV.
1
dotNET

Il s’agit d’un code compilé provenant de différentes sources et tiré de ce même article. Ma contribution est un code qui copie TOUS les codes de VBE (Sheets/Thisworkbook/Userforms/Modules/Classes) dans un nouveau classeur.

j'ai créé cela, car j'ai un classeur corrompu et un code permettant de récupérer tout ce qui n'est pas corrompu, y compris le code. (cette partie ne récupère que le code + les 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
0
Patrick Lepelletier