Question

我有20个人字形形状的分组，用于识别您到电子表格的距离。用户从选项卡1开始，第一个人字形为彩色，然后继续。标签15上有15个人字形，而标签20上所有20个人字形均是彩色的。

我曾尝试标识以前的活动工作表，但是却不断出错。用户可以从选项卡1跳至5至10，或从选项卡20跳至5至13。结果，我无法使用.previous命令。我尝试使用全局变量代替停用工作表来获取lastWS名称，因为我认为这是最好的方法，但无济于事。 IE浏览器这是我的全局变量

Public lastWS As Worksheet

要更改人字形颜色，效果很好，我会在工作表激活时致电

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

在每个工作表上，我都有这个功能来识别上次使用的工作表：

Private Sub Worksheet_DeActivate()
  Set lastWS = ActiveSheet
End Sub

我的模块代码是：

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

在这种情况下，它表明未找到具有指定名称的项目。使用调试器，我发现这是因为使用取消激活过程时，我的lastWS成为当前工作表。

如何使用这种方式使用上一个工作表？

Answer 1

使用Set lastWS = ActiveSheet而不是Set lastWS = Me。

此外，我想您在所有工作表中都有Activate和Deactivate事件吗？

您可以使用Workbook_SheetActivate模块中的Workbook_SheetDeactivate和ThisWorkbook的单个实例

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

此外，您的chevronColours子对象也可以像这样通过工作簿

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

并定义为

Sub chevronColours(currentWS As Worksheet)

我想您会发现chevronColours代码还有其他一些问题。这是重构的代码

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

存储对工作表的引用

我所做的是使用Static ChevronList As Object引用ArrayList。工作表名称将添加到ArrayList。 ArrayList.IndexOf_3(Worksheet.Name)返回工作表名称的从零开始的索引。

Better Soulutions - Static Variables

变量确实有生命周期。指示在两次调用之间保留局部变量。可以将静态变量视为具有内存的局部变量。静态变量是一个局部变量，其生存期是整个模块的生存期，而不是声明它的过程。实际上，只要代码模块处于活动状态，静态变量就会保留其值。不必一直运行任何代码。因此，静态变量的作用域是局部变量，而生存期是模块级变量。

使用形状

您应该给该组取一个有意义的名称。

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

将名称数组传递给Shapes.Range()属性，将返回数组中所有形状的ShapeRange。使用ShapeRange修改一组形状的属性比分别更改它们更有效。

工作簿事件

正如克里斯·尼尔森（Chris Neilsen）所述，使用Workbook_SheetActivate而不是各个工作表的Worksheet_Activate事件。我建议还建议从Workbook_Open事件中调用子例程。用户启用内容后，Workbook_Open会触发。如果用户打开工作簿，更改工作表，然后启用内容

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

我没有费心使用上一个工作表来跟踪组的位置。在该组中搜索20张纸实际上是瞬时的，可以防止可能的错误。

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

修改后的代码以将Shape Index而不是Shape Name添加到results（）中。使用形状名称似乎存在错误。我要问这个错误。由于更改，需要将雪佛龙按顺序添加到组中。

Download Chevrons Demo.xlsm。主要代码在工作簿的代码模块中。 PrepWorkbook模块中提供了用于准备工作簿，添加工作表和V形的代码。

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

2 个答案:

存储对工作表的引用

使用形状

工作簿事件