如何使用 Shapes.AddShape 方法添加相机对象

Question

如果我录制宏。我看到这段代码。

Selection.Copy
ActiveSheet.Shapes.AddShape(, 480.75, 171#, 63#, 63#).Select
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Application.CutCopyMode = False

当我查看 MsoAutoShapeType 枚举时，我看不到相机对象。

如果我更改任何值，它会给出异常... (, 480.75, 171#, 63#, 63#) 文档说这些值是顶部、左侧、宽度和高度...

我想编写一个方法，可以在我给定的任何范围内创建相机对象，

Sub TakePhoto(myRange As String, myPicture As String)

我怎样才能实现这一点？

Answer 1

试试这个：

Sub TakePhoto(rngSource As Excel.Range, rngTarget As Excel.Range)
Dim ws As Excel.Worksheet
Dim shpPicture As Excel.Shape

Set ws = rngTarget.Parent
rngSource.Copy
ws.Pictures.Paste Link:=True
Set shpPicture = ws.Shapes(ws.Shapes.Count)
With shpPicture
    .Top = rngTarget.Top
    .Left = rngTarget.Left
End With
End Sub

这样称呼它：

Sub test()
TakePhoto Sheet2.Range("A1:C4"), Sheet1.Range("c5")
End Sub