复制并粘贴一个形状到另一个表格，并调整到单元格大小

我有一个问题，在同一个Excel文件中复制和粘贴一个形状。

我在一个Excel文件中有两个表格，在表格“表格1”中只有一个图片，我假设自动获得名称为“图片1”。 我想复制这张图片，并将其粘贴到名为“概览”的表格中，该表格与“表格1”在同一个Excel文件中。 我想将此图片粘贴到单元格A1，我希望它适合单元格大小，不会比单元格A1大。

我怎样才能做到这一点 ？

Answer 1

Dim pasteCell As Range Set pasteCell = Sheets("Overview").Range("A1") Sheets("Tabelle1").Shapes("Picture1").Copy Sheets("Overview").Paste pasteCell Sheets("Overview").Shapes(1).Height = pasteCell.Height Sheets("Overview").Shapes(1).Width = pasteCell.Width 

假设概览表中没有图像。

Answer 2

 Option Explicit Sub Copy_Shape() Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim PasteCell As Range Dim Pic1 As Shape Dim Pic2 As Shape With ThisWorkbook Set Sh1 = .Sheets("Tabelle 1") Set Sh2 = .Sheets("Overview") End With Set Pic1 = Sh1.Shapes("Picture 1") Pic1.Copy With Sh2 .Paste Set Pic2 = .Shapes(.Shapes.Count) Set PasteCell = .Cells(1, 1) End With With Pic2 .Height = PasteCell.Height .Width = PasteCell.Width .Top = PasteCell.Top .Left = PasteCell.Left End With Set Pic1 = Nothing Set Pic2 = Nothing Set PasteCell = Nothing Set Sh1 = Nothing Set Sh2 = Nothing End Sub 

如果你是VBA新手，这是一个很好的练习。