Excel VBA遍历形状时触发1004运行时错误的原因排查

针对你遇到的问题，以下是具体排查方向：

• 定位特殊形状类型：并非所有Shape对象都支持TopLeftCell属性（比如部分ActiveX控件、嵌入的独立图表等）。在循环中添加调试输出，找到触发错误的形状：

  For Each sh In wsh.Shapes
      Debug.Print "形状名称：" & sh.Name & "，类型：" & sh.Type ' 输出到VBA立即窗口
      Set sh_cell = sh.TopLeftCell
      ' 后续原有代码
  Next sh
  

  运行后按Ctrl+G打开VBA编辑器的「立即窗口」，查看最后输出的形状信息，该形状大概率是错误源头。

• 修正合并单元格的行高设置逻辑：你的代码注释提到要处理合并单元格，但直接对sh_cell.RowHeight赋值会触发错误——合并单元格的行高需通过MergeArea对象统一设置：

  ' 替换原行sh_cell.RowHeight = sh.Height + 10
  sh_cell.MergeArea.RowHeight = sh.Height + 10
  

  若单元格未合并，MergeArea会自动指向单元格自身，不影响正常逻辑。

• 检查工作表保护状态：如果工作表"Wyniki"处于保护状态，默认不允许修改行高，会直接抛出1004错误。可临时解除保护后再执行操作：

  Set wsh = ThisWorkbook.Worksheets("Wyniki")
  Dim wasProtected As Boolean
  wasProtected = wsh.ProtectContents
  If wasProtected Then wsh.Unprotect ' 临时解除保护
  ' 原有循环代码
  If wasProtected Then wsh.Protect ' 恢复保护（若需要）
  

• 移除冗余的Select操作：代码中的sh.Select完全多余，且选中操作可能因工作表未激活引发额外错误，直接删除该行即可。

• 验证形状位置有效性：若形状左上角完全处于工作表可见区域外（比如行号/列标范围外），TopLeftCell可能指向无效单元格。可添加判断确保操作范围有效：

  Set sh_cell = sh.TopLeftCell
  If Not Intersect(sh_cell, wsh.UsedRange) Is Nothing Then
      ' 原有列判断和行高设置代码
  End If
  

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