Excel 2016 VBA从工作表复制图片并自动调整到另一工作表的文本框中

Question

我在“徽标”表的左上角有一张图片“图片 1”。 这是通过另一个宏来的。 现在我想要一个宏来复制“图片1”并将其粘贴到“Voorblad”表上的文本框“TextboxLogo”中。 图片应自动调整为文本框高度的 90%，并在垂直和水平方向居中。

这是我目前得到的代码：

Sub Macro1()
Dim picture As Shape

Sheets("Logo").Activate
picture = ActiveSheet.Shapes.Range(Array("Picture 1"))
Sheets("Voorblad").Visible = True
With Sheets("Voorblad").Shapes("TextBoxLogo").Fill
    .Visible = True
    .UserPicture picture
    .TextureTile = True
    .RotateWithObject = True
End With

End Sub

由于图片与所有单元格重叠，我必须使用文本框。

当我运行它时，我得到运行时错误 91，对象变量或块变量未设置。 我搜索了这个论坛和谷歌，但没有成功。

希望我能走上这条路

Answer 1

Dim picture As Shape

Shape 是对象类型，picture 是对象变量。

picture = ActiveSheet.Shapes.Range(Array("Picture 1"))

您不能像这样分配对象引用。运行时错误告诉您的是，缺少 Set 关键字。

Set picture = ActiveSheet.Shapes.Range(Array("Picture 1"))

---

也就是说你不需要Sheets("Logo").Activate。

Set picture = ActiveWorkbook.Worksheets("Logo").Shapes.Range(Array("Picture 1"))

或者，如果"Logo" 工作表在运行宏的工作簿中存在于编译时，请将其(Name) 属性设置为LogoSheet，然后您可以这样做：

Set picture = LogoSheet.Shapes.Range(Array("Picture 1"))

如果它存在于运行宏的工作簿中，但仅在运行时创建，则您也不需要 ActiveWorkbook：

Set picture = ThisWorkbook.Worksheets("Logo").Shapes.Range(Array("Picture 1"))

---

如果形状Picture 1 是单个形状，则.Range(Array(...)) 的东西是多余的，这可能就是您所需要的（假设您将该工作表的(Name) 属性设置为LogoSheet：

Set picture = LogoSheet.Shapes("Picture 1")