Question

我正在尝试为Excel写一个VBA宏，以嵌入和调整图像尺寸以保持纵横比。我想嵌入而不是链接，以便Excel文件可以在计算机之间共享。

我有2条代码。

1st将嵌入图像（SaveWithDocument），放置图像并更改高度（但不保持纵横比）。

Sub Button7_Click()

With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Submit"
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then

Set pic = ActiveSheet.Shapes.AddPicture(.SelectedItems(1), _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=1050, _
        Top:=35, _
        Width:=-1, _
        Height:=150)

Else
            MsgBox ("No picture inserted")
        End If
    End With

End Sub

2nd将链接图像，调整图像位置并更改高度（保持纵横比）。此选项不会嵌入图像。

Sub Button7_Click()

With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Submit"
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then

With ActiveSheet.Pictures.Insert(.SelectedItems(1))
    .ShapeRange.lockaspectratio = msoTrue
    .Left = 1050
    .Top = 35
    .Height = 150
End With

Else
            MsgBox ("No picture inserted")
        End If
    End With

End Sub

尽管这两段代码可以分别很好地工作，但是我无法将它们组合在一起。我了解“ SaveWithDocument”不适用于“ Pictures.Insert”，“ LockAspectRatio”不适用于“ Shapes.AddPicture”吗？

有人可以提供一些指导吗？

非常感谢。

Answer 1

如果分两步进行操作，我认为它将起作用，即以原始大小插入图像并设置LockAspectRatio，然后调整其大小。

Set pic = ActiveSheet.Shapes.AddPicture(.SelectedItems(1), _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoCTrue, _
    Left:=1050, _
    Top:=35, _
    Width:=-1, _
    Height:=-1).LockAspectRatio = msoTrue
pic.Height = 150

Answer 2

似乎现在需要解决，并且效果很好。非常感谢您的帮助。

Sub Button7_Click()

With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .ButtonName = "Submit"
        .Title = "Select an image file"
        .Filters.Clear
        .Filters.Add "JPG", "*.JPG"
        .Filters.Add "JPEG File Interchange Format", "*.JPEG"
        .Filters.Add "Graphics Interchange Format", "*.GIF"
        .Filters.Add "Portable Network Graphics", "*.PNG"
        .Filters.Add "Tag Image File Format", "*.TIFF"
        .Filters.Add "All Pictures", "*.*"

        If .Show = -1 Then

        Dim pic As Shape
        Set pic = ActiveSheet.Shapes.AddPicture(.SelectedItems(1), _
           LinkToFile:=msoFalse, _
         SaveWithDocument:=msoCTrue, _
         Left:=1050, _
         Top:=35, _
         Width:=-1, _
         Height:=-1)
      pic.lockaspectratio = msoTrue
      pic.Height = 150

      Else
        MsgBox ("No picture inserted")
       End If

End With

End Sub

在Excel中嵌入图像并调整其大小，以保持宽高比

2 个答案: