使用VBA设置形状/图片的公式

Question

我想使用VBA为图片设置公式。

这是VBA简化版本的一部分，用于插入和修改给定URL中的形状/图片。

Dim theShape As Shape
Filename = cell
' Use Shapes instead so that we can force it to save with the document
Set theShape = ActiveSheet.Shapes.AddPicture( _
Filename:=Filename, linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
Left:=cell.Left, Top:=cell.Top, Width:=60, Height:=60)
With theShape
.LockAspectRatio = msoTrue
' Shape position and sizes stuck to cell shape
.Top = cell.Top + 1
.Left = cell.Left + 1
.Height = cell.Height - 2
.Width = cell.Width - 2
' Move with the cell (and size, though that is likely buggy)
.Placement = xlMoveAndSize
.Name = "Item" & cell.Row
'******What to enter here to set the "Formula" for the picture?
'Trying to set the formula to an existing named range, such as "FQPic3"
'Something like: .formula = FQPic3
End With

但是，我没有看到图片属性来设置公式。

谢谢。

Answer 1

这将允许您设置公式：

Dim theShape As Shape
Filename = cell
' Use Shapes instead so that we can force it to save with the document
Set theShape = ActiveSheet.Shapes.AddPicture( _
Filename:=Filename, linktofile:=msoFalse, _
savewithdocument:=msoCTrue, _
Left:=cell.Left, Top:=cell.Top, Width:=60, Height:=60)
With theShape
.LockAspectRatio = msoTrue
' Shape position and sizes stuck to cell shape
.Top = cell.Top + 1
.Left = cell.Left + 1
.Height = cell.Height - 2
.Width = cell.Width - 2
' Move with the cell (and size, though that is likely buggy)
.Placement = xlMoveAndSize
.Name = "Item" & cell.Row
'******What to enter here to set the "Formula" for the picture?
'Trying to set the formula to an existing named range, such as "FQPic3"
'Something like: .formula = FQPic3
theShape.OLEFormat.Object.Formula = "=FQPic3"
End With

旁注：没有检查你的代码的其余部分