Excel 2003宏迁移至2016出现VBA运行时错误1004排查求助

Hey there, let's work through this VBA grouping error you're hitting in Excel 2016! That Run-time error 1004 is happening because your current code is trying to group duplicate shape references—here's why and how to fix it:

The Root Cause #

That "HACK" code you mentioned fills empty sBoxName array slots with the last valid shape name when fewer than 8 boxes are drawn. When you pass this array to .Range(Array(...)), you end up with duplicate entries for the same shape. Excel 2016 is less tolerant of this than 2003, so it throws the error when trying to group a shape multiple times.

Fix 1: Build a Unique List of Shape Names #

Instead of passing the full (possibly duplicated) array, create a collection of only unique, valid shape names first, then convert it to an array for grouping. This avoids duplicates entirely:

' First, collect unique valid shape names
Dim validShapes As Collection
Set validShapes = New Collection

' Add fixed shapes (sPutName, sTriName) - skip duplicates if any
On Error Resume Next
validShapes.Add sPutName, Key:=sPutName
validShapes.Add sTriName, Key:=sTriName
On Error GoTo 0

' Add box names, skipping duplicates and empty values
Dim box As Integer
For box = 0 To 7
    If sBoxName(box) <> "" Then
        On Error Resume Next
        validShapes.Add sBoxName(box), Key:=sBoxName(box)
        On Error GoTo 0
    End If
Next box

' Convert collection to an array for .Range
Dim shapeArray() As String
ReDim shapeArray(1 To validShapes.Count)
Dim i As Integer
For i = 1 To validShapes.Count
    shapeArray(i) = validShapes(i)
Next i

' Group the shapes (no need for .Select - direct object manipulation is better!)
With .Range(shapeArray)
    sPutGrouped = "put" & Trim(str(puts - iPutStart + 1))
    .Group.Name = sPutGrouped
End With

Fix 2: Track Actual Drawn Box Count (Cleaner Approach) #

If you can track how many boxes were actually drawn (you probably have a counter variable when creating the shapes), use that to only include valid box names in your grouping array:

' Assume you have a variable `actualBoxCount` that equals the number of boxes drawn (1-8)
Dim shapeArray() As String
ReDim shapeArray(1 To 2 + actualBoxCount) ' 2 for sPutName + sTriName

' Add fixed shapes
shapeArray(1) = sPutName
shapeArray(2) = sTriName

' Add only the boxes that were actually drawn
Dim box As Integer
For box = 0 To actualBoxCount - 1
    shapeArray(3 + box) = sBoxName(box)
Next box

' Group the shapes
With .Range(shapeArray)
    sPutGrouped = "put" & Trim(str(puts - iPutStart + 1))
    .Group.Name = sPutGrouped
End With

Bonus Tips #

• Avoid .Select: Old VBA code relies on selecting objects, but this is unstable and unnecessary. Directly manipulate the shape range as shown above for more reliable code.
• Debugging Trick: Before grouping, add Debug.Print statements to check your shape names for duplicates:

  ' Print all names to the Immediate Window (Ctrl+G in VBA Editor)
  Dim item As Variant
  For Each item In Array(sPutName, sTriName, sBoxName(0), sBoxName(1), sBoxName(2), sBoxName(3), sBoxName(4), sBoxName(5), sBoxName(6), sBoxName(7))
      Debug.Print item
  Next
  

  This will quickly show you if duplicates are present.

内容的提问来源于stack exchange，提问作者bpmccain