vba 使用vba将导入的图片保存在excel中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12435125/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
save imported picture in excel using vba
提问by theStupidOne
So I have a macro assigned to a command button. when pressed it opens a dialogue box for user to import a picture file. Then it resizes the image and puts it on a specific cell. But If I move the original picture file location, the image disappears in Excel. Is there any chance I can save it inside the excel file so that it will not matter if I move the original file location.
所以我有一个分配给命令按钮的宏。按下时会打开一个对话框，供用户导入图片文件。然后它调整图像大小并将其放在特定单元格上。但是如果我移动原始图片文件的位置，图像在 Excel 中就会消失。是否有机会将其保存在 excel 文件中，以便移动原始文件位置无关紧要。
The code is as follow:
代码如下：
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
回答by chris neilsen
.Pictures.Insertdoesn't seem to provide control over linking or imbedding.
.Pictures.Insert似乎没有提供对链接或嵌入的控制。
However you can use this instead
但是你可以用它来代替
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
回答by Rohit Jaiswal
Adding to the answer by Chris, additionally, I wanted to maintain the aspect ratio of the downloaded image. The problem was the AddPicture method mandates the arguments for width and height both. The trick which worked was putting those values as "-1" and then changing only height with locked aspect ratio.
除了 Chris 的回答之外，我还想保持下载图像的纵横比。问题是 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
