Reassigning OnAction for button across Workbooks with VBA

AwooOOoo

New Member
Joined
Feb 26, 2012
Messages
12
Hi,
I am trying to move a sheet from one workbook to another workbook. The moving of the worksheet actually works, but I'm having 2 issues;

1) The source sheet has a button (shape) on allows a user to do some stuff via a Userform. When I move the WorkSheet the button to the still points at the old Macro, but reassigning the OnAction doesn't seem to work.

When I execute the following line:
Code:
            new_sh.Shapes("EditResources_Button").OnAction = "'" & prj & "'!EditResource_Menu"

...and I watch variable it doesn't change which leaves my sheet referencing the first sheet to execute the macro.

I even tried deleting the button after it was copied and adding it again to the sheet, but it still refers to the macro in the source worksheet.

2) As part of the move I open, copy, save and close the target workbook, but leave the source workbook open in case the user has other stuff they need to do. If I try to save the source workbook excel seems to hang while saving, but if I press the [x] to close the worksheet it closes. If I press the [X] to close excel it won't and I need to use task manager to close excel even though there is no workbooks open.


Here is the code for the function in question:

Code:
'Move a worksheet from one workbook to another
'Workbook needs to be a .xlsm file in the same directory
Private Sub MoveButton_Click()
    Dim sh As Worksheet, new_sh As Worksheet
    Dim from_wb, wb As Workbook
    Dim prj As String
        
    'Name of the current workbook
    Set from_wb = ActiveWorkbook
    
    prj = MoveProject_Form.ProjectToMove.Value
    
    'Check values were selected for the project and workbook
    If (prj = "" Or MoveProject_Form.ToProjectFile.Value = "") Then
        MsgBox ("The 'Project to Move' and 'Project File to Move To' both need to be set")
    Else
        Dim f As String
        f = ActiveWorkbook.Path & "\" & MoveProject_Form.ToProjectFile.Value    'Workbook the Sheet will be moved to
        
        'Check the destination workbook exists (in case it was typed)
        If Dir(f) = "" Then
            MsgBox "The File you entered does not exist. Select a File from the dropdown menu."
            Exit Sub
        End If
        
        'Check the worksheet exists (in case it was typed)
        If (SheetExists(prj)) Then
            'Open the destination workbook
            Set wb = GetWorkbook(f)
    
            'Check the target workbook does not already have this worksheet (project)
            If (SheetExists(prj, wb)) Then
                MsgBox ("Target Workbook already has a worksheet (project) with this name. Aborting Move.")
                'Close the destination workbook
                wb.Close SaveChanges:=False     'No changes were made
                Exit Sub
            End If
            
            Set sh = from_wb.Sheets(prj)        'Sheet that will be moved
                
            'Disable warnings that will be triggered from copying named ranges and deleting source sheet
            Application.DisplayAlerts = False
            
            'Copy the sheet to the selected workbook
            sh.Copy After:=wb.Sheets(wb.Sheets.Count - 1)
            
            'Delete the worksheet from the source workbook
            sh.Delete
            Application.DisplayAlerts = True    'Renable warnings
            
            'ISSUE HERE: Reassign the 'Edit Resources' Button to point to the script from in new sheet
            Set new_sh = wb.Sheets(prj)
            'new_sh.Shapes("EditResources_Button").OnAction = "'[" & MoveProject_Form.ToProjectFile.Value & "]'!EditResource_Menu"


            'ALTERNATE METHOD: Delete and add button again (also doesn't work)
            new_sh.Shapes("EditResources_Button").Delete
            
            new_sh.Activate
            ActiveSheet.Buttons.Add(15, 1035, 120, 16.8).Select
            Selection.OnAction = "EditResource_Menu"
            Selection.Characters.Text = "Edit Resources"
            With Selection.Characters(Start:=1, Length:=14).Font
                .name = "Calibri"
                .FontStyle = "Regular"
                .Size = 11
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 1
            End With


            'Update the Project List and Summary tabs
            UpdateProjectSummaryList
            UpdateProjectSpendSummary
           
            wb.Sheets("Configuration").Activate
        
            'Close the destination workbook
            wb.Close SaveChanges:=True
            Unload Me
        Else
            MsgBox ("The Project you entered does not exist. Select a Project from the dropdown menu.")
            Exit Sub
        End If
    End If
End Sub

Any advice on the two list issues is welcome as well as any other pitfalls I may have ran into with this code.

Sincerely, Paul.
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Watch MrExcel Video

Forum statistics

Threads
1,129,804
Messages
5,638,455
Members
417,025
Latest member
MusterDuster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top