你的思路完全可行！不过原代码只实现了形状居中，没搞定形状大小适配单元格区域和单元格尺寸变化时自动调整这两个核心需求。我帮你修改代码，同时补上自动触发的逻辑，完美满足你的要求：

一、核心适配代码：让形状匹配单元格区域尺寸 #

先创建一个通用的子程序，用来调整形状大小并对齐到目标单元格区域（B1:C1）：

Sub AdjustShapeToRange()
    Dim targetShape As Shape
    Dim targetRange As Range
    
    ' 替换成你的目标形状名称和单元格区域
    Set targetShape = ActiveSheet.Shapes("Rectangle 1")
    Set targetRange = ActiveSheet.Range("B1:C1")
    
    With targetShape
        ' 直接让形状宽高匹配区域的总宽高
        .Width = targetRange.Width
        .Height = targetRange.Height
        ' 让形状左上角和区域左上角对齐（比原居中逻辑更直接适配需求）
        .Left = targetRange.Left
        .Top = targetRange.Top
    End With
End Sub

代码说明： #

• 直接将形状的宽高设置为B1:C1区域的总宽度和高度（比如你提到的220像素）
• 取消了原代码的选中操作，直接通过对象引用操作形状，避免选中单元格/形状带来的干扰
• 对齐逻辑简化为左上角对齐，确保形状完全覆盖目标区域

二、实现单元格宽度变更时自动调整 #

要让形状在单元格宽度变化时自动适配，需要添加应用级的列宽变化监听事件：

1. 按Alt + F11打开VBA编辑器
2. 在左侧工程窗口中，双击ThisWorkbook模块
3. 在代码窗口的左侧下拉框选择Application，右侧下拉框选择SheetColumnWidthChange，然后粘贴以下代码：

Private Sub Application_SheetColumnWidthChange(ByVal Sh As Object, ByVal Target As Range)
    ' 替换成你的目标工作表名称（比如"Sheet1"）
    If Sh.Name = "Sheet1" Then
        ' 仅当B列或C列宽度变化时触发（避免无关列调整时的无效触发）
        If Not Intersect(Target, Sh.Range("B:C")) Is Nothing Then
            ' 调用形状适配子程序
            AdjustShapeToRange
        End If
    End If
End Sub

注意事项： #

• 把AdjustShapeToRange子程序放在标准模块中（右键工程窗口→插入→模块，然后粘贴代码），不要放在工作表或ThisWorkbook模块里
• 确保你的工作表名称和形状名称与代码中的一致，否则会报错

测试方法 #

1. 手动调整B列或C列的宽度
2. 形状会自动调整大小，完全匹配B1:C1区域的新尺寸

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