Как я могу вставить изображение в ячейку на 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Ó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 (или любом другом языке), я совершенно потерян и немного разочарован.

Спасибо!

Answer 1

Вам необходимо установить свойства 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