VBA Excel 2010 – embedded图片和resize

我已经潜伏了一段时间，发现它非常有帮助，所以感谢您的帮助！

我试图写一个macros，将图像embedded到单个文件的工作表中，并调整它们的大小，同时保持图像的完整分辨率，如果需要再次放大。 首先我试了一下：

ActiveSheet.Pictures.Insert(imageName).Select With Selection.ShapeRange .Height = 100 .Width = 100 End With 

这基本上插入一个链接到图片，如果图像文件被删除或Excel文件移动到另一台计算机，链接将被打破。 接下来我尝试了：

 ActiveSheet.Shapes.AddPicture Filename:=imageName, _ linktofile:=msoFalse, _ savewithdocument:=msoCTrue, _ Width:=100, _ Height:=100 

这个代码也可以工作，但是在插入之前图像的大小被调整为100 * 100像素，所以原来的文件分辨率会丢失。

有没有办法插入图像文件， 然后缩小尺寸，以保持原来的分辨率？

非常感谢，亚当。

Answer 1

您首先加载并放置原始大小的图片，然后在第二步中根据需要resize。 您只能指定宽度或高度来保持宽高比。

 Sub Test() Dim MySht As Worksheet Dim MyPic As Shape Dim MyLeft As Single, MyTop As Single ' position in Pixel relative to top/left of sheet MyTop = 50 MyLeft = 50 ' alternatively position to the top/left of [range] C3 MyTop = [C3].Top MyLeft = [C3].Left ' alternatively position to top/left of actual scrolled position MyTop = Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn).Top MyLeft = Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn).Left Set MySht = ActiveSheet Set MyPic = MySht.Shapes.AddPicture("C:\Users\MikeD\Desktop\Untitled.png", _ msoFalse, msoTrue, MyLeft, MyTop, -1, -1) ' ^^^ LinkTo SaveWith -1 = keep size ' now resize pic MyPic.Height = 100 End Sub 

…并尽量避免。select…调Dim您需要的对象并使用它们。