¿Cómo exportar botón con macro asignada a otro libro de Excel?

Hola:

Tengo una pequeña duda sobre los botones en Excel con macros asignadas

Lo que intento hacer es exportar el botón con una macro asignada de un libro a otro libro

Se como exportar las macros, pero no el botón y quiero evitarme tener que crear el botón con diseño personalizado y después asignarle la macro cada vez que quiera usar dicho botón y macro en otro libro.

En pocas palabras quiero exportar botón y macro a cualquier libro en un solo paso

Gracias por tu tiempo

1

1 respuesta

Respuesta
1

Te anexo las macros y las indicaciones.

En la macro tienes que poner los siguientes datos:

El nombre del libro "archivo" y de la hoja "Hoja1" que tiene el botón.

El nombre del libro "libro9" y de la hoja destino "Hoja1"

El nombre de la macro "proceso"

El nombre del módulo que contiene la macro "Módulo3"

En tu libro que tiene el botón con la macro, pon lo siguiente en un módulo nuevo:

Sub copiarmacro()
'Por.Dante Amor
    Dim nombremodulo As String
    Application.ScreenUpdating = False
    Set l1 = Workbooks("archivo")
    Set h1 = l1.Sheets("Hoja1")
    '
    libro = "libro9"
    Set l2 = Workbooks.Open(libro)
    Set h2 = l2.Sheets("Hoja1")
    nombremacro = "proceso"
    nombremodulo = "Módulo3"
    l1.Activate
    CopyModule nombremodulo, l1.VBProject, l2.VBProject, True
    For Each obj In h1.DrawingObjects
        mn = obj.OnAction
        If obj.OnAction = "'" & l1.Name & "'!" & nombremacro Then
            obj.Copy
            arr = obj.Top
            izq = obj.Left
            l2.Activate
            h2.Paste
            Selection.OnAction = l2.Name & "!" & nombremacro
            Selection.Top = arr
            Selection.Left = izq
            h2.Range("A1").Select
            Exit For
        End If
    Next
    Application.DisplayAlerts = False
    l2.SaveAs Filename:=l2.Path & "\" & libro & ".xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    l2.Close
End Sub


En otro módulo nuevo dentro del mismo libro que tiene el botón inserta la siguiente función

Function CopyModule(ModuleName As String, _
    FromVBProject As VBIDE.VBProject, _
    ToVBProject As VBIDE.VBProject, _
    OverwriteExisting As Boolean) As Boolean
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' CopyModule
    ' This function copies a module from one VBProject to
    ' another. It returns True if successful or  False
    ' if an error occurs.
    '
    ' Parameters:
    ' --------------------------------
    ' FromVBProject The VBProject that contains the module
    ' To be copied.
    '
    ' ToVBProject           The VBProject into which the module is
    ' To be copied.
    '
    ' ModuleName The name of the module to copy.
    '
    ' OverwriteExisting     If True, the VBComponent named ModuleName
    '                       in ToVBProject will be removed before
    '                       importing the module. If False and
    '                       a VBComponent named ModuleName exists
    '                       in ToVBProject, the code will return
    '                       False.
    'Referencia: http://www.cpearson.com/excel/vbe.aspx
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim VBComp As VBIDE.VBComponent
    Dim FName As String
    Dim CompName As String
    Dim s As String
    Dim SlashPos As Long
    Dim ExtPos As Long
    Dim TempVBComp As VBIDE.VBComponent
    '''''''''''''''''''''''''''''''''''''''''''''
    ' Do some housekeeping validation.
    '''''''''''''''''''''''''''''''''''''''''''''
    If FromVBProject Is Nothing Then
        CopyModule = False
        Exit Function
    End If
    If Trim(ModuleName) = vbNullString Then
        CopyModule = False
        Exit Function
    End If
    If ToVBProject Is Nothing Then
        CopyModule = False
        Exit Function
    End If
    If FromVBProject.Protection = vbext_pp_locked Then
        CopyModule = False
        Exit Function
    End If
    If ToVBProject.Protection = vbext_pp_locked Then
        CopyModule = False
        Exit Function
    End If
    On Error Resume Next
    Set VBComp = FromVBProject.VBComponents(ModuleName)
    If Err.Number <> 0 Then
        CopyModule = False
        Exit Function
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' FName is the name of the temporary file to be
    ' used in the Export/Import code.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    FName = Environ("Temp") & "\" & ModuleName & ".bas"
    If OverwriteExisting = True Then
        ''''''''''''''''''''''''''''''''''''''
        ' If OverwriteExisting is True, Kill
        ' The existing temp file and remove
        ' the existing VBComponent from the
        ' ToVBProject.
        ''''''''''''''''''''''''''''''''''''''
        If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
            Err.Clear
            Kill FName
            If Err.Number <> 0 Then
                CopyModule = False
                Exit Function
            End If
        End If
        With ToVBProject.VBComponents
            .Remove .Item(ModuleName)
        End With
    Else
        '''''''''''''''''''''''''''''''''''''''''
        ' OverwriteExisting is False. If there is
        ' already a VBComponent named ModuleName,
        ' exit with a return code of False.
        ''''''''''''''''''''''''''''''''''''''''''
        Err.Clear
        Set VBComp = ToVBProject.VBComponents(ModuleName)
        If Err.Number <> 0 Then
            If Err.Number = 9 Then
                ' module doesn't exist. ignore error.
            Else
                ' other error. get out with return value of False
                CopyModule = False
                Exit Function
            End If
        End If
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Do the Export and Import operation using FName
    ' and then Kill FName.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''
    FromVBProject.VBComponents(ModuleName).Export Filename:=FName
    '''''''''''''''''''''''''''''''''''''
    ' Extract the module name from the
    ' export file name.
    '''''''''''''''''''''''''''''''''''''
    SlashPos = InStrRev(FName, "\")
    ExtPos = InStrRev(FName, ".")
    CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
    ''''''''''''''''''''''''''''''''''''''''''''''
    ' Document modules (SheetX and ThisWorkbook)
    ' cannot be removed. So, if we are working with
    ' a document object, delete all code in that
    ' component and add the lines of FName
    ' back in to the module.
    ''''''''''''''''''''''''''''''''''''''''''''''
    Set VBComp = Nothing
    Set VBComp = ToVBProject.VBComponents(CompName)
    If VBComp Is Nothing Then
        ToVBProject.VBComponents.Import Filename:=FName
    Else
        If VBComp.Type = vbext_ct_Document Then
            ' VBComp is destination module
            Set TempVBComp = ToVBProject.VBComponents.Import(FName)
            ' TempVBComp is source module
            With VBComp.CodeModule
                .DeleteLines 1, .CountOfLines
                s = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
                .InsertLines 1, s
            End With
            On Error GoTo 0
            ToVBProject.VBComponents.Remove TempVBComp
        End If
    End If
    Kill FName
    CopyModule = True
End Function


La macro abre el libro, le copia el módulo con la macro, le copia el botón y le asigna la macro.

Saludos. Dante Amor

Recuerda valorar la respuesta.

Me faltó comentar que tienes que agregar una referencia en VBA. Selecciona del menú de VBA Herramientas / Referencias

Ahora busca la siguiente referencia "Microsoft Visual Basic For Applications Extensibility 5.3." en la lista de referencias disponibles, marca la casilla de verificación y presiona Aceptar.

Después de agregar la referencia copia las macros que te envié.

Saludos. Recuerda valorar la respuesta

Dante Amor

Recuerda valorar la respuesta.

No he recibido comentarios, Recuerda valorar la respuesta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas