将形状从上一个工作表移动到当前工作表

Question

I have a grouping of 20 chevron shapes, used to identify how far into the spreadsheet you are. Users start on tab 1 the first chevron is coloured, and continue along. On tab 15, 15 chevrons are coloured, and on tab 20, all 20 chevrons are coloured.

I have tried identifying the previous active worksheet, but I constantly get errors. Users can jump from tab 1 to 5 to 10, or from tab 20, to 5 to 13. As a result, I cannot use the .previous command. I have tried using a global variable in lieu with the worksheet deactivate to get the lastWS name, as I feel this is the best method, but to no avail. IE this is my global variable

Public lastWS As Worksheet

To change chevron colours, which works fine, I call when the worksheet is activated

Private Sub Worksheet_Activate()
  Call chevronColours(1)
End Sub

on each worksheet I have this to recognize the last used worksheet:

Private Sub Worksheet_DeActivate()
  Set lastWS = ActiveSheet
End Sub

and my module code is:

Sub chevronColours(k As Integer)

Dim r As Integer, g As Integer, b As Integer, i As Integer
Set wbk = ThisWorkbook
Set currentWS = ActiveSheet
lastWS.Shapes("Group 2").Cut
wbk.ActiveSheet.Range("B2").Select
wbk.ActiveSheet.Paste

For i = 1 To 19
  If i <= k Then
    currentWS.Shapes("Chevron " & i).Fill.ForeColor.RGB = RGB(0, 255, 0)
  Else
    currentWS.Shapes("Chevron " & i).Fill.ForeColor.RGB = RGB(255, 255, 255)
  End If
Next i

End Sub

In this scenario it says that the item with the specified name was not found. Using the debugger I found this to be because when using the deactivate procedure, my lastWS become the current worksheet.

What can I do to use the previous worksheet in this way?

Answer 1

Rather than Set lastWS = ActiveSheet use Set lastWS = Me .

Also, I guess you have the Activate and Deactivate events in all workssheets?

You could do it with a single instance of Workbook_SheetActivate and Workbook_SheetDeactivate in the ThisWorkbook module

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Set lastWS = Sh
End Sub

Also, your chevronColours Sub could be passed the workbook, like this

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    chevronColours Sh
End Sub

and defined as

Sub chevronColours(currentWS As Worksheet)

I think you will find there are a few other issues with your chevronColours code. Here's your code refactored

Sub chevronColours(currentWS As Worksheet)
    Dim k As Long, i As Long
    Dim rng As Range
    Dim shp As Shape
    Dim g As GroupObject

    Application.ScreenUpdating = False
    Set rng = Selection
    lastWS.Shapes("Group 2").Cut
    currentWS.Paste
    Set g = Selection
    rng.Select
    g.Name = "Group 2"
    With currentWS.Range("B2")
        g.Top = .Top
        g.Left = .Left
    End With
    k = currentWS.Index
    If g.ShapeRange.GroupItems.Count = currentWS.Parent.Worksheets.Count Then
        For i = 1 To g.ShapeRange.GroupItems.Count
            g.ShapeRange.GroupItems(i).Fill.ForeColor.RGB = IIf(i <= k, vbGreen, vbWhite)
        Next i
    Else
        ' Sheets vs chevron count mismatch
        '  what now?
    End If
    Application.ScreenUpdating = True
End Sub

Answer 2

Storing References to the Worksheets

What I did was use Static ChevronList As Object reference an ArrayList. The worksheet names are added to the ArrayList. ArrayList.IndexOf_3(Worksheet.Name) returns the zero based Index of the worksheet name.

Better Soulutions - Static Variables

Variables do have a lifetime. Indicates that the local variable is preserved between calls. A static variable can be thought of as a local variable with memory. A static variable is a local variable whose lifetime is the lifetime of the entire module and not the procedure where it is declared. In fact static variables retain their values as long as the code module is active. There does not have to be any code running all the time. Therefore a static variable has the scope of a local variable but the lifetime of a module level variable.

Working with Shapes

You should give the group a meaningful name.

  ActiveSheet.Shapes("Group 2").Name = "Chevron Group" 

Passing an array on names to the Shapes.Range() property returns a ShapeRange of of all the shapes in the array. Using the ShapeRange to modify the properties of a group of shapes is more efficient then changing them individually.

Workbook Events

As Chris Neilsen mentioned use the Workbook_SheetActivate instead of the Worksheet_Activate events of the individual worksheets. I recommend also recommend calling the subroutine from the Workbook_Open event. The Workbook_Open fires after the user has enabled the content. If the user opens the workbook, changes worksheets, and then enables the content

 Private Sub Workbook_Open() MoveChevronGroup ActiveSheet.Range("B2") End Sub 

---

I didn't bother using the last worksheet to track the location of the group. Searching 20 sheets for the group is virtually instantaneous and will prevent possible bugs.

---

Option Explicit
Const DebugMode = True

Private Sub Workbook_Open()
    MoveChevronGroup ActiveSheet.Range("B2")
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Application.ScreenUpdating = False
    MoveChevronGroup sh.Range("B2")
    Application.ScreenUpdating = True
End Sub

Private Sub MoveChevronGroup(Optional Destination As Range)
    Const GroupName As String = "Chevron Group"
    Static ChevronList As Object
    Dim ChevronGroup As Shape, ws As Worksheet
    Dim results() As Variant
    Dim ChevronCount As Long, n As Long
    If ChevronList Is Nothing Then Set ChevronList = CreateObject("System.Collections.ArrayList")

    For Each ws In ThisWorkbook.Worksheets
        On Error Resume Next
        Set ChevronGroup = ws.Shapes(GroupName)
        On Error GoTo 0
        If Not ChevronGroup Is Nothing Then Exit For
    Next

    Set ws = Destination.Parent

    If Not ChevronGroup.Parent.Name = ws.Name Then
        ChevronGroup.Cut
        Destination.Parent.Paste
        Set ChevronGroup = ws.Shapes(GroupName)
        ChevronGroup.Left = Destination.Left
        ChevronGroup.Top = Destination.Top
    End If

    If Not ChevronList.Contains(ws.Name) Then ChevronList.Add ws.Name
    ChevronCount = ChevronList.IndexOf_3(ws.Name) + 1

    If DebugMode Then Debug.Print "ChevronList.Count: "; ChevronList.Count, "ChevronList.IndexOf_3(ws.Name) + 1: "; ChevronList.IndexOf_3(ws.Name) + 1

    ReDim results(ChevronCount - 1)
    For n = 1 To ChevronCount
        results(n - 1) = n
    Next

    If DebugMode Then Debug.Print "Results Array Values: "; Join(results, ",")

    ChevronGroup.Fill.ForeColor.RGB = RGB(255, 255, 255)
    ChevronGroup.GroupItems.Range(results).Fill.ForeColor.RGB = RGB(0, 255, 0)
End Sub

Modified code to add the Shape Index instead of the Shape Name to the results(). There seems to be a bug using the shape names. I am going to ask SO about the bug. Because of the change the Chevroons need to be added to the group in order.

Download Chevrons Demo.xlsm . The main code is in the Workbook's code module. The code for prepping the workbook, adding sheets and Chevrons, are in the PrepWorkbook module.