作为VBA新手，遇到形状组合失败的问题很常见，我们一步步拆解错误、修正代码，同时解决你代码里的其他小问题：

一、核心错误：形状组合代码的问题 #

你原来的组合代码有两个关键错误：

Dim ShapeArray As Variant
ShapeArray(0) = Box1.Name
ShapeArray(1) = ActiveShape.Name
ActiveSheet.Shapes.Range(ShapeArray(0, 1)).Group

1. 未初始化Variant数组：直接给ShapeArray(0)赋值会触发"下标越界"错误，因为Variant数组默认没有维度
2. Shapes.Range的用法错误：它接受的是完整数组，不是ShapeArray(0,1)这种索引范围写法

二、修正后的组合代码 #

把数组初始化和Range调用改成下面的写法，就能成功组合两个形状：

'Group the two boxes together
Dim ShapeArray As Variant
' 用Array()函数直接初始化包含两个形状名称的数组
ShapeArray = Array(Box1.Name, ActiveShape.Name)
' 传入数组创建形状范围，完成组合
Dim groupedShape As Shape
Set groupedShape = ActiveSheet.Shapes.Range(ShapeArray).Group

三、完整修正后的Button2_Click过程 #

除了组合问题，你的代码还有未定义变量、错误处理逻辑不严谨的问题，下面是修正后的完整代码：

Option Explicit ' 强制变量声明，避免未定义变量的错误
Sub Button2_Click()
    Dim ActiveShape As Shape
    Dim UserSelection As Variant
    Dim Box1 As Shape
    Dim tope As Double
    Dim temp1 As String
    Dim selTxt As Variant
    Dim i As Integer
    
    ' 获取屏幕选中内容
    Set UserSelection = ActiveWindow.Selection
    
    ' 尝试将选中内容转为Shape对象
    On Error Resume Next
    Set ActiveShape = ActiveSheet.Shapes(UserSelection.Name)
    On Error GoTo 0 ' 关闭错误捕获
    
    ' 检查是否成功获取到形状
    If ActiveShape Is Nothing Then
        MsgBox "You do not have a shape selected!"
        Exit Sub
    End If
    
    ' 给选中形状添加边框
    With ActiveShape.Line
        .Weight = 5
        .ForeColor.RGB = RGB(21, 2, 191)
    End With
    
    ' 在选中形状内创建小文本框
    tope = ActiveShape.Top
    Set Box1 = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveShape.Left, tope, 10, 10)
    Box1.Fill.ForeColor.RGB = RGB(40, 30, 166)
    
    ' 组合两个形状
    Dim ShapeArray As Variant
    ShapeArray = Array(Box1.Name, ActiveShape.Name)
    Dim groupedShape As Shape
    Set groupedShape = ActiveSheet.Shapes.Range(ShapeArray).Group
    
    ' 添加"In Prog"文本（修正原代码中变量未定义的问题）
    temp1 = ActiveShape.TextFrame.Characters.Caption
    If InStr(temp1, "In Prog") = 0 Then
        selTxt = Split(temp1, Chr(10))
        ActiveShape.TextFrame.Characters.Caption = selTxt(0) & " In Prog"
        For i = 1 To UBound(selTxt)
            ActiveShape.TextFrame.Characters.Caption = ActiveShape.TextFrame.Characters.Caption & vbNewLine & selTxt(i)
        Next i
        ' 更简洁的写法可以直接用：
        ' ActiveShape.TextFrame.Characters.Caption = temp1 & vbNewLine & "In Prog"
    End If
End Sub

四、关键知识点解析 #

• 数组初始化：用Array()函数可以快速创建包含形状名称的数组，避免手动赋值的维度错误
• 错误处理优化：原代码的错误处理会在正常执行时也弹出提示框，现在改为检查ActiveShape是否为Nothing，逻辑更严谨
• 显式变量声明：添加Option Explicit可以强制你定义所有变量，避免拼写错误或未定义变量导致的隐藏bug
• 组合体引用：把组合后的形状赋值给groupedShape变量，方便后续对组合体进行操作（比如移动、修改样式）

五、额外注意事项 #

1. 确保两个形状都在同一个工作表中（代码中统一用Sheet1或ActiveSheet，避免跨工作表组合的问题）
2. 如果组合的是OLE类型的形状（比如用户窗体创建的带OLEFormat的形状），组合后可以通过groupedShape.Shapes(1)或groupedShape.Shapes(2)访问内部单个形状
3. 组合操作会替换原有的两个独立形状，所以如果需要保留原形状，要提前复制一份

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