如何将图像插入 vba 上的单元格?

Question

我正在研究这个 excel 宏，我一直在编写的代码(正如我所期望的那样糟糕(检查 G：G 范围内的每个单元格，并根据其值插入图像。事实是我不知道如何使图像插入已检查的单元格中。 我在编写代码时附加了代码...

Private Sub CommandButton1_Click()
Dim Cell As Range
For Each Cell In Range("G:G")
If Cell.Value = 1 Then
Call ActiveSheet.Shapes.AddPicture("S:10_INGENIERÍA DE FUNDICIÓN3_CALIDADCalidad centralSeptiembre 2019IMAGENESC1.png", _
msoCTrue, msoCTrue, 0, 0, 25, 25)
ElseIf Cell.Value = 2 Then
Call ActiveSheet.Shapes.AddPicture("S:10_INGENIERÍA DE FUNDICIÓN3_CALIDADCalidad centralSeptiembre 2019IMAGENESC2.png", _
msoCTrue, msoCTrue, 0, 0, 25, 25)

ElseIf Cell.Value = 3 Then
Call ActiveSheet.Shapes.AddPicture("S:10_INGENIERÍA DE FUNDICIÓN3_CALIDADCalidad centralSeptiembre 2019IMAGENESC3.png", _
msoCTrue, msoCTrue, 0, 0, 25, 25)

ElseIf Cell.Value = 4 Then
Call ActiveSheet.Shapes.AddPicture("S:10_INGENIERÍA DE FUNDICIÓN3_CALIDADCalidad centralSeptiembre 2019IMAGENESC4.png", _
msoCTrue, msoCTrue, 0, 0, 25, 25)

End If
Next
End Sub

当我单击命令按钮时，图像会插入到A1旁边，并且它们一个接一个。我希望它们位于检查值所在的单元格中，范围为 G：G。 我一直在阅读它，我一直在尝试许多不同的方法，但由于我不擅长 vba(或任何其他语言(，我完全迷失了，有点绝望。

谢谢！

Answer 1

您需要按如下方式设置 Left 和 Top 属性...

Call ActiveSheet.Shapes.AddPicture("S:10_INGENIERÍA DE FUNDICIÓN3_CALIDADCalidad centralSeptiembre 2019IMAGENESC1.png", _
msoCTrue, msoCTrue, Cell.Left, Cell.Top, 25, 25)

但是，您的宏可以重写如下...

Private Sub CommandButton1_Click()
Dim PathToFolder As String
PathToFolder = "S:10_INGENIERÍA DE FUNDICIÓN3_CALIDADCalidad centralSeptiembre 2019IMAGENES"
'Make sure path ends in backslash ()
If Right(PathToFolder, 1) <> "" Then
PathToFolder = PathToFolder & ""
End If
Dim Cell As Range
Dim ImageFile As String
For Each Cell In Range("G1:G" & Cells(Rows.Count, "G").End(xlUp).Row) 'define range until last used row
If Len(Cell) > 0 Then 'cell contains a value
If Cell.Value = 1 Then
ImageFile = PathToFolder & "C1.png"
ElseIf Cell.Value = 2 Then
ImageFile = PathToFolder & "C2.png"
ElseIf Cell.Value = 3 Then
ImageFile = PathToFolder & "C3.png"
ElseIf Cell.Value = 4 Then
ImageFile = PathToFolder & "C4.png"
Else
ImageFile = ""
End If
If Len(ImageFile) > 0 Then 'variable contains a non-empty string
If Len(Dir(ImageFile, vbNormal)) > 0 Then 'image file exists
ActiveSheet.Shapes.AddPicture ImageFile, msoCTrue, msoCTrue, Cell.Left, Cell.Top, 25, 25
End If
End If
End If
Next Cell
End Sub