无法对两个形状进行分组，然后对形状进行分组

Question

我尝试运行此程序时收到错误。它是一个用户窗体，通过双击excel中的形状弹出。 userform允许您将盒子的状态从正常更改为“进行中”到“完成”。此更改会在原件中创建一个框，并添加如图所示的边框。

第一次更改时，此功能正常。但是，一旦您将状态更改为编程或完成后您无法再次更改它或您收到以下错误：

我能够通过使用两个按钮反复更改状态，但是一旦我在userform中合并到一个组合框中，我就开始体验这一点，下面显示了Userform的代码，并且出现错误的行将以粗体显示。在此先感谢您的帮助。

  Private Sub UserForm_Initialize()

'fill combobox catagory
Me.cmbCAT.AddItem "L1U"
Me.cmbCAT.AddItem "L1L"
Me.cmbCAT.AddItem "IN"
Me.cmbCAT.AddItem "SC"
Me.cmbCAT.AddItem "GE"
Me.cmbCAT.AddItem "TE"
Me.cmbCAT.AddItem "ExD"


'fill combobox resources
Me.cmbResource.AddItem "Item1"
Me.cmbResource.AddItem "Item2"

'fill combobox Status
Me.cmbStatus.AddItem ""
Me.cmbStatus.AddItem "In Prog"
Me.cmbStatus.AddItem "Done"

End Sub

Private Sub btnSubmit_Click()

Dim AShape As Shape
Dim USelection As Variant
Dim ShapeArray(0 To 1) As String
Dim ShapeArr(0 To 1) As String


        'Pull-in what is selected on screen
Set USelection = ActiveWindow.Selection

        'Determine if selection is a shape
Set AShape = ActiveSheet.Shapes(Sheet4.Range("B1"))



If cmbCAT.Text = "L1U" Then
   ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(255, 180, 18)
ElseIf cmbCAT.Text = "L1L" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(147, 196, 22)
ElseIf cmbCAT.Text = "SC" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(147, 196, 22)
ElseIf cmbCAT.Text = "IN" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(255, 255, 70)
ElseIf cmbCAT = "GE" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(255, 173, 203)
ElseIf cmbCAT = "TE" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(114, 163, 255)
Else
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(159, 2, 227)
End If

Sheet4.Range("A3").Value = tbSP.Value
Sheet4.Range("A4").Value = tbDROP.Value
Sheet4.Range("A5").Value = cmbCAT.Text
Sheet4.Range("A6").Value = tbUS.Value
Sheet4.Range("A7").Value = tbTITLE.Text
Sheet4.Range("A8").Value = cmbResource.Text
Sheet4.Range("A9").Value = tbDES.Text
Sheet4.Range("A10").Value = cmbStatus.Text



ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption = tbSP & "-" & tbDROP & "." & cmbCAT & "." & tbUS & vbNewLine & _
"Resource: " & cmbResource & vbNewLine & _
"Description: " & tbDES & vbNewLine


'Update if status is "In progress"

If Sheet4.Range("A10") = "In Prog" Then
    With ActiveSheet.Shapes(Sheet4.Range("B1")).line
        .Weight = 5
        .ForeColor.RGB = RGB(2, 199, 6)
    End With

    Dim Box1 As Shape
    Set Box1 = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveSheet.Shapes(Sheet4.Range("B1")).Left + ActiveSheet.Shapes(Sheet4.Range("B1")).Width - 50, ActiveSheet.Shapes(Sheet4.Range("B1")).TOP + ActiveSheet.Shapes(Sheet4.Range("B1")).Height - 20, 50, 20)

    Box1.Fill.ForeColor.RGB = RGB(2, 199, 6)
    Box1.OLEFormat.Object.Caption = "In Prog"

                'Group the two boxes together



    ShapeArray(0) = Box1.Name
    ShapeArray(1) = ActiveSheet.Shapes(Sheet4.Range("B1")).Name

    **ActiveSheet.Shapes.Range(Array(ShapeArray(0), ShapeArray(1))).Group**

'Update if Status is "done"
ElseIf Sheet4.Range("A10") = "Done" Then
     With ActiveSheet.Shapes(Sheet4.Range("B1")).line
        .Weight = 5
        .ForeColor.RGB = RGB(61, 134, 212)
    End With

    Dim Box2 As Shape
    Set Box2 = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveSheet.Shapes(Sheet4.Range("B1")).Left + ActiveSheet.Shapes(Sheet4.Range("B1")).Width - 50, ActiveSheet.Shapes(Sheet4.Range("B1")).TOP + ActiveSheet.Shapes(Sheet4.Range("B1")).Height - 20, 50, 20)

    Box2.Fill.ForeColor.RGB = RGB(61, 134, 212)
    Box2.OLEFormat.Object.Caption = "Done"

                   'Group the two boxes together




    ShapeArr(0) = Box2.Name
    ShapeArr(1) = ActiveSheet.Shapes(Sheet4.Range("B1")).Name

    **ActiveSheet.Shapes.Range(Array(ShapeArr(0), ShapeArr(1))).Group**





End If

Unload UF2

End Sub

似乎阵列设置不正确。这是否与已经在群组中的原始形状有关？我尝试取消分组，但这会导致第一次状态更改时出现另一个错误，因为它取消了形状，但它尚未属于某个组。当我使用两个单独的按钮来改变状态时，我没有遇到过这种情况。