时间戳

首页 > 解决方案 > 如何在 vba 上将图像插入单元格？

vba - 如何在 vba 上将图像插入单元格？

问题描述

我正在处理这个 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ÓN\03_CALIDAD\Calidad central\Septiembre 2019\IMAGENES\C1.png", _
   msoCTrue, msoCTrue, 0, 0, 25, 25)

   ElseIf Cell.Value = 2 Then
   Call ActiveSheet.Shapes.AddPicture("S:\10_INGENIERÍA DE FUNDICIÓN\03_CALIDAD\Calidad central\Septiembre 2019\IMAGENES\C2.png", _
   msoCTrue, msoCTrue, 0, 0, 25, 25)


   ElseIf Cell.Value = 3 Then
   Call ActiveSheet.Shapes.AddPicture("S:\10_INGENIERÍA DE FUNDICIÓN\03_CALIDAD\Calidad central\Septiembre 2019\IMAGENES\C3.png", _
   msoCTrue, msoCTrue, 0, 0, 25, 25)


   ElseIf Cell.Value = 4 Then
   Call ActiveSheet.Shapes.AddPicture("S:\10_INGENIERÍA DE FUNDICIÓN\03_CALIDAD\Calidad central\Septiembre 2019\IMAGENES\C4.png", _
   msoCTrue, msoCTrue, 0, 0, 25, 25)


   End If

   Next

   End Sub

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

谢谢！

标签： vbaimage

解决方案

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

Call ActiveSheet.Shapes.AddPicture("S:\10_INGENIERÍA DE FUNDICIÓN\03_CALIDAD\Calidad central\Septiembre 2019\IMAGENES\C1.png", _
   msoCTrue, msoCTrue, Cell.Left, Cell.Top, 25, 25)

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

Private Sub CommandButton1_Click()

    Dim PathToFolder As String
    PathToFolder = "S:\10_INGENIERÍA DE FUNDICIÓN\03_CALIDAD\Calidad central\Septiembre 2019\IMAGENES\"

    '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

推荐阅读