Move shape(button 1) from active sheet to next sheet

[tubrak]

Hi experts

I have code create sheets . what I want procedure to put in the end of the code to move shape(button 1) from active sheet to next sheet after the code create new sheet added by code . I don't want copying button 1 , just move from active sheet to next sheet .

example: active sheet is STOCK and move the button 1 to the new added sheet will be STOCK_JAN and when STOCK_JAN is active and move the button 1 to the new added sheet will be STOCK_FEB and so on .

thanks

 

[tubrak]

Ok I tested again , but still add new sheet based on your code , shouldn't do it .

 

[John_w]

Yes, my code adds a new sheet, but it needs to in order to show how to move the button from the active sheet to the new sheet.

It's up to you to take the parts of my code you need to move the button and incorporate it into your own code.

Post your own code if you want further help with moving the button.

 

[Jaafar Tribak]

Alternatively, if you don't want to incorporate John's code into your own, you could try using the sheet events which will automatically fire when your code is executed.

Something along these lines might work for you:

Code goes In the ThisWorkbook Module:

Option Explicit

Const BUTTON_NAME = "Button 1"  '<== change button name as required.

Dim oPrevSh As Worksheet, oBtn As Shape

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If ButtonExists(Sh) Then
        Set oPrevSh = Sh
        Set oBtn = Sh.Shapes(BUTTON_NAME)
    Else
        Set oPrevSh = Nothing
    End If
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Application.OnTime Now, Me.CodeName & ".MoveButton"
End Sub

Private Sub MoveButton()
    Dim buttonLeft As Single, buttonTop As Single
    If Not oPrevSh Is Nothing Then
        With oBtn
            buttonLeft = .Left
            buttonTop = .Top
            .Cut
        End With
        ActiveSheet.Paste
        With ActiveSheet.Shapes(BUTTON_NAME)
            .Left = buttonLeft
            .Top = buttonTop
            .TopLeftCell.Select
        End With
    End If
End Sub

Private Function ButtonExists(ByVal Sh As Worksheet) As Boolean
    Dim oShp As Shape
    On Error Resume Next
    Set oShp = Sh.Shapes(BUTTON_NAME)
    ButtonExists = Not (oShp Is Nothing)
End Function

 

[tubrak]

Alternatively, if you don't want to incorporate John's code into your own, you could try using the sheet events which will automatically fire when your code is executed.

I'm not sure how your procedures work . I put it as you said!
may you check the file,please? the file contains STOCK_FEB is active and the button is almost B1
also John you could check the file contains code if you can combine with your code .
TT (2).xlsm
I hope this helps.

 

[Jaafar Tribak]

When I run the test1 macro , no worksheets are added as the
If Not Evaluate("isref('STOCK_" & m(i - 1) & "'!a1)") Then
statement never evaluates to True. I haven't gone through your code thoroughly to see when the above statement evaluates to True before it adds a new sheet, but I think you can tweak John's code and incorporate it as follows :

Sub test1()
    Dim i As Long, ii As Long, m, ws As Worksheet
    Dim col As Long, x(1 To 3), s As String, d As Long
    m = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT.NOV.DEC", ",")
    Set ws = Sheets("STOCK")
    For i = 1 To 3
        x(i) = ws.Columns(i).ColumnWidth
    Next
    For i = 1 To Month(Date)
        If Not Evaluate("isref('STOCK_" & m(i - 1) & "'!a1)") Then
            If i = 1 Then s = "STOCK" Else s = "STOCK_" & m(i - 2)
           
            'Moving the button here
            Set PrevSheet = ThisWorkbook.ActiveSheet
            Sheets.Add(, Sheets(s)).Name = "STOCK_" & m(i - 1)
            Call Move_Button(PrevSheet)
           
            Sheets("stock").Columns("a:c").Copy Sheets("stock_" & m(i - 1)).[a1]
        End If
        If i = Month(Date) Then
            d = Day(Date)
        Else
            d = Day(DateSerial(Year(Date), i + 1, 0))
        End If
        With Sheets("stock_" & m(i - 1))
            If .[a1].CurrentRegion.Columns.Count < d + 3 Then
                Sheets("stock").[d1].Copy .[d1].Resize(, d)
                With .[d1].Resize(, d)
                    .Formula = "=date(year(today())," & i & ",column(a1))"
                    .Value = .Value
                End With
            End If
        End With
        If i > 1 Then Set ws = Sheets("STOCK_" & m(i - 2))
        With ws.[a1].CurrentRegion
            col = .Parent.Evaluate("max(if(" & .Offset(1).Address & "<>"""",column(" & .Address & ")))")
            .Columns(col).Copy Sheets("STOCK_" & m(i - 1)).[c1]
        End With
        With Sheets("STOCK_" & m(i - 1))
            .[c1] = ws.[c1]
            .[a1].CurrentRegion.Borders.Weight = 2
            .Columns.AutoFit
            For ii = 1 To 3
                .Columns(ii).ColumnWidth = x(ii)
            Next
            .Rows.AutoFit
        End With
    Next
End Sub


Sub Move_Button(ByVal oPrevSh As Worksheet)

    Dim oldButton As Button, newButton As Button
   
    Set oldButton = oPrevSh.Buttons("Button 1")
    With oldButton
        Set newButton = ThisWorkbook.ActiveSheet.Buttons.Add(.Left, .Top, .Width, .Height)
        newButton.Name = .Name
        newButton.Caption = .Caption
        newButton.OnAction = .OnAction
        'Set other button properties as required
        .Delete
    End With
     
End Sub

If this works, just get rid of the code I posted in post#13. You won't need both.

 

[tubrak]

When I run the test1 macro , no worksheets are added as the

because it has already added STOCK_MAR based on current month . you can delete STOCK_MAR and run the code will add again.

I think you can tweak John's code and incorporate it as follows :

work , but not completely !
will show error object required after work.

 

[tubrak]

also will resize by increase the button width .

 

[tubrak]

cross posted in this forum
Move shape(button 1) from active sheet to next sheet

 

[tubrak]

It's solved by jindon's owner of code
the data will start from row4, not 1 as I attached in post #14
if anybody interests here is the code .

Sub test1()
    Dim i As Long, ii As Long, m, ws As Worksheet, sp As Shape
    Dim col As Long, x(1 To 3), s As String, d As Long
    Application.EnableEvents = False
    Application.CopyObjectsWithCells = False
    m = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT.NOV.DEC", ",")
    Set ws = Sheets("STOCK")
    For i = 1 To 3
        x(i) = ws.Columns(i).ColumnWidth
    Next
    For i = 1 To Month(Date)
        If Not Evaluate("isref('STOCK_" & m(i - 1) & "'!a1)") Then
            If i = 1 Then s = "STOCK" Else s = "STOCK_" & m(i - 2)
            Sheets.Add(, Sheets(s)).Name = "STOCK_" & m(i - 1)
            Sheets("stock").Columns("a:c").Copy Sheets("stock_" & m(i - 1)).[a1]
        End If
        If i = Month(Date) Then
            d = Day(Date)
        Else
            d = Day(DateSerial(Year(Date), i + 1, 0))
        End If
        With Sheets("stock_" & m(i - 1))
            If .Shapes.Count Then
                If i <> Month(Date) Then
                    If Not sp Is Nothing Then
                        sp.Delete: Set sp = .Shapes(1)
                    End If
                End If
            End If
            If .[a4].CurrentRegion.Columns.Count < d + 3 Then
                Sheets("stock").[d4].Copy .[d4].Resize(, d)
                With .[d4].Resize(, d)
                    .Formula = "=date(year(today())," & i & ",column(a4))"
                    .Value = .Value
                End With
            End If
        End With
        If i > 1 Then Set ws = Sheets("STOCK_" & m(i - 2))
        If ws.Shapes.Count Then Set sp = ws.Shapes(1)
        With ws.[a4].CurrentRegion
            col = .Parent.Evaluate("max(if(" & .Offset(1).Address & "<>"""",column(" & .Address & ")))")
            .Columns(col).Copy Sheets("STOCK_" & m(i - 1)).[c4]
        End With
        With Sheets("STOCK_" & m(i - 1))
            .[c4] = ws.[c4]
            .[a4].CurrentRegion.Borders.Weight = 2
            .Columns.AutoFit
            For ii = 1 To 3
                .Columns(ii).ColumnWidth = x(ii)
            Next
            .Rows.AutoFit
            If i = Month(Date) Then
                If .Shapes.Count = 0 Then
                    sp.Copy: .[a1].PasteSpecial
                    .Shapes(1).OnAction = "test1"
                    With .Shapes(1)
                        .Left = sp.Left: .Top = sp.Top
                    End With
                End If
                .Select: .[a1].Select
                If Not sp Is Nothing Then sp.Delete
            End If
        End With
    Next
    Application.CopyObjectsWithCells = True
    Application.EnableEvents = True
End Sub

thanks guys for try to help me