为何VBA中无法修改导入至目标Worksheet的Shape位置？

问题场景 #

你编写的VBA子程序用于从另一个已打开工作簿的源工作表，向当前活动工作簿的目标工作表导入图片和文本框。Shape能成功复制，但修改top和left属性调整位置完全没效果，且目标工作表已解除保护，问题仍存在。

原代码：

Sub importShapes(target As Worksheet, source As Worksheet)
    Dim sourceShape As Shape
    For Each sourceShape In source.Shapes
        If sourceShape.Type = msoPicture Or sourceShape.Type = msoTextBox Then
            sourceShape.Copy
            target.Paste
           
            Dim targetShape As Shape
            Set targetShape = target.Shapes(target.Shapes.Count) ' the shape just added
            
            targetShape.top = sourceShape.top
            targetShape.left = sourceShape.left
        End If
    Next
End Sub

问题原因 #

跨工作簿粘贴时，target.Paste会默认将内容粘贴到当前活动工作表，而非你指定的target工作表。这时候你通过target.Shapes.Count获取的Shape根本不是刚复制过去的那个，修改位置自然无效。

修正方案 #

改用target.Shapes.Paste明确指定粘贴到目标工作表的Shapes集合，同时直接捕获粘贴返回的Shape对象，避免计数获取的误差：

Sub importShapes(target As Worksheet, source As Worksheet)
    Dim sourceShape As Shape
    Dim pastedShapes As ShapeRange
    
    For Each sourceShape In source.Shapes
        If sourceShape.Type = msoPicture Or sourceShape.Type = msoTextBox Then
            sourceShape.Copy
            ' 明确粘贴到目标工作表的Shapes集合
            Set pastedShapes = target.Shapes.Paste
            ' 获取刚粘贴的单个Shape
            Dim targetShape As Shape
            Set targetShape = pastedShapes(1)
            
            ' 同步原Shape的位置
            targetShape.Top = sourceShape.Top
            targetShape.Left = sourceShape.Left
        End If
    Next
End Sub

额外说明 #

• Shapes.Paste返回的是ShapeRange对象，因为一次复制可能粘贴多个Shape，这里我们处理单个Shape，直接取pastedShapes(1)即可
• 确保目标工作表确实处于未保护状态（包括取消所有可能的工作表保护设置）

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