copy - 将形状从一张纸复制并粘贴到另一张纸上

Question

有人能告诉我为什么这个 excel VBA 将形状从一张纸复制并粘贴到另一张纸上失败了吗？我的工作簿中存在形状“StandingsPix”和工作表“图片”，事实上，当我手动录制宏来执行此操作时，它会创建类似的代码。

它在“未设置对象变量”的“p”分配中失败。非常感谢帮助。

Sub CopyPictureToScorecard(TargetCells As Range)

Dim p As Shape
Dim p2 As Shape
Dim TargetWS As Worksheet

    Set TargetWS = Sheets("Scorecards")

    p = Sheets("Pictures").Shapes.Range(Array("StandingsPix"))      <== Fails Here

    p.Copy
    TargetWS.Paste

    'make sure the picture is properly centered on the scorecard
    Set p2 = TargetWS.Shapes(TargetWS.Shapes.Count)

            p2.Width = p.Width
            p2.Height = p.Height
            p2.Top = TargetCells.Top + (TargetCells.Height / 2) - (p2.Height / 2)
            p2.Left = TargetCells.Left + (TargetCells.Width / 2) - (p2.Width / 2)
            p2.Line.Visible = False

End Sub

当我手动录制一个宏时（成功！），这是它生成的代码：

Sheets("Pictures").Select
ActiveSheet.Shapes.Range(Array("StandingsPix")).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Scorecards").Select
Range("K24").Select
ActiveSheet.Paste
Selection.ShapeRange.IncrementLeft 621
Selection.ShapeRange.IncrementTop -369.75

标签： copypasteshapes

Answer 1

Sub CopyPictureToScorecard(TargetCells As Range)

   Dim p As Shape

   Set p = Sheets("Pictures").Shapes("StandingsPix")

     Sheets("ScoreCards").Shapes.AddShape _
       Type:=p.AutoShapeType, _
       Left:=TargetCells.Top + (TargetCells.Height / 2) - (p2.Height / 2), _
       Top:=TargetCells.Top + (TargetCells.Height / 2) - (p2.Height / 2), _
       Width:=p.Width, _
       Height:=p.Height
    
End Sub