我正在尝试创建一个按钮,用于打开对话框并允许用户:
- 从他们的文件中选择照片,
- 将该文件嵌入按钮所在的特定单元格,
- 并允许它移动和大小沿着该细胞,同时保持高宽比(感谢皮卡dbmitch)
我使用*expression*.Insert.Picture()
方法。当我发送工作表时,图片被替换为:
照片已被移动、删除或编辑。
似乎此方法链接了文件。
现在我尝试使用*expression*.shapes.addPicture()
的旧方法。
我想我已经成功添加了照片。
我无法调整大小或锁定到单元格工作。下面两种尝试。
Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
With img
'Resize Picture to fit in the range....
.Left = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Left
.Top = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Top
.Width = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Width
.Height = ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Height
.Placement = 1
.PrintObject = True
End With
End Sub
Sub TestPic()
Dim ws As Worksheet, s As Shape
Set ws = ActiveSheet
' Insert the image.
Set s = ws.Shapes.AddPicture(Application.GetOpenFilename(Title:="Please work"), _
False, True, ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Left, _
ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Top, _
ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Width, _
ActiveSheet.Range(ActiveSheet.Shapes(Application.Caller).TopLeftCell.Address).Height)
' Use picture's height and width.
End Sub
1条答案
按热度按时间p3rjfoxz1#
我能够得到这个代码在Excel 2016 VBA中运行。你没有说你从哪里运行这个,但我假设应用程序。调用者不是来自模块?也许是用户窗体?
以下是对我有效的方法-希望您可以使用它