Excel VBA - 将图像(使用对话框)插入特定单元格

Question

所以我在这里和互联网上的各个网站上进行了广泛的搜索，但我很难找到答案。我也不是最精通 VBA 的用户。

基本上，我需要什么:单击按钮时，会弹出“插入图像”对话框，用户选择单个图像文件，并且该图像应插入到单元格 B2 中。理想情况下，我想调整该图像的大小，使其不长于 X，也不高于 Y。

这是我到目前为止的代码(它给我一个“运行时错误 424”并指向 TextBox1.Value 行)。任何建议/改进总是非常感谢!

Sub ChangeImage()

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
    TextBox1.Value = .SelectedItems(1)
    Image1.PictureSizeMode = fmPictureSizeModeZoom
    Image1.Picture = LoadPicture(.SelectedItems(1))

Else
    MsgBox ("Cancelled.")
End If
End With
End Sub

谢谢!

-A

Answer 1

这是通过不同类型的插入来实现此目的的一种方法。示例还展示了如何定位和缩放图像。

Sub ChangeImage()
    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 img As Object
            Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))

            'Scale image size
            'img.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
            'img.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft

            'Position Image
            img.Left = 50
            img.Top = 150

            'Set image sizes in points (72 point per inch)
            img.Width = 150
            img.Height = 150
        Else
            MsgBox ("Cancelled.")
        End If
    End With
End Sub