3

所以我有一个分配给命令按钮的宏。按下它会打开一个对话框供用户导入图片文件。然后它调整图像的大小并将其放在特定的单元格上。但是如果我移动原始图片文件的位置，图像在 Excel 中就会消失。有没有机会我可以将它保存在 excel 文件中，这样如果我移动原始文件位置就无关紧要了。

代码如下：

    Sub Add_Image()
    Application.ScreenUpdating = False
    Range("B18").Select
    'varible Picture1 is inserted down below - ***change both***
    Picture1 = Application.GetOpenFilename("Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
    'edit "("Picture,*.*")" section to add or chanve visible file types
    On Error GoTo ErrMsg
    ActiveSheet.Pictures.Insert(Picture1).Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Height = 145
    Selection.ShapeRange.Width = 282
    Application.ScreenUpdating = True
    Exit Sub
ErrMsg:
    MsgBox ("Failed to load Image"), , "Error"
End Sub
4

2 回答 2

4

.Pictures.Insert似乎没有提供对链接或嵌入的控制。

但是，您可以改用它

expression.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

Sub Add_Image()
    Dim pic As Object
    Dim rng As Range

    Application.ScreenUpdating = False
    Set rng = Range("B18")
    Set rng2 = Range("A1", rng.Offset(-1, -1))
    'varible Picture1 is inserted down below - ***change both***
    Picture1 = Application.GetOpenFilename( _
        "Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")
    'edit "("Picture,*.*")" section to add or chanve visible file types

    On Error GoTo ErrMsg
    With Range("A1", rng.Offset(-1, -1))
        Set pic = ActiveSheet.Shapes.AddPicture(Picture1, False, True, _
            .Width, .Height, 282, 145)
    End With
    With pic
        .LockAspectRatio = msoFalse
    End With
    Application.ScreenUpdating = True
Exit Sub
ErrMsg:
    MsgBox ("Failed to load Image"), , "Error"
End Sub
于 2012-09-15T07:15:51.440 回答
2

另外，克里斯的答案是，我想保持下载图像的纵横比。问题是 AddPicture 方法同时要求宽度和高度的参数。有效的技巧是将这些值设置为“-1”，然后仅更改具有锁定纵横比的高度。

    Set picCell = cell.Offset(0, 1)

    Set pic = ActiveSheet.Shapes.AddPicture(fileString, False, True,_
          picCell.Left + 10, picCell.Top + 10, -1, -1)
    With pic
          .LockAspectRatio = msoTrue
          .Height = 200
    End With
于 2015-02-04T06:14:50.263 回答