VBA Excel 2010 - 嵌入图片和调整大小 [英] VBA Excel 2010 - Embedding Pictures and Resizing

问题描述

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

I've been lurking for a while and found it very helpful, so thanks for the help already!

我正在尝试写一个宏来嵌入图像从单个文件转换成工作表，并调整它们的大小，同时保持图像的完整分辨率，如果需要再次放大。首先我试过：

I'm trying to write a macro to embed images into a worksheet from individual files and resize them, whilst keeping the full resolution of the image intact should it need to be enlarged again. First of all I tried:

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

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

This essentially inserted a link to the picture and if the image file was removed or the excel file moved to another computer, the link would be broken. Next I tried:

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

此代码也可以正常工作，但在插入之前图像的大小调整为100 * 100像素，因此原始文件解析度将丢失。

This code also works, but the image is resized to 100 * 100 pixels before insertion, so the original file resolution is lost.

有没有插入图像文件的方法和然后缩小尺寸，以保留原始分辨率？

Is there any way to insert image files and then scale them down in size, so that the original resolution is retained?

非常感谢，Adam。 p>

Many thanks, Adam.

推荐答案

您首先加载并定位图片的原始大小，然后按照需要调整大小。您只需指定EITHER宽度或高度来保留宽高比。

You first load and position the picture in its original size, and in a second step resize it as desired. You only specify EITHER width or heigth to retain the aspect ratio.

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

...并尝试避免。选择 ... Dim 您需要的对象并使用它们。

... and try to avoid .Select ... Dim the objects you need and use them.

这篇关于VBA Excel 2010 - 嵌入图片和调整大小的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！