EXCEL-VBA/MACRO插入图片

Question

我将数据放在用于打印标签的纸张上的表格中。

我能够将数据放入我想要的单元格中，但无法添加徽标。

如何将徽标从第 3 行开始放置在 C 列中？

Sub etiket()

    Dim i As Long, st1 As Byte, st2 As Byte, st3 As Byte
    Dim st4 As Byte
    
    Dim yol As String
    yol = "C:\Users\pc\Desktop\labelexample\logo.jpg"

    Sheets("etiket").Select
    Range("A3:A" & Rows.Count).ClearContents
    
    st1 = 1: st2 = 2: st3 = 3: st4 = 4
    
    With Sheets("veri")
        sat = 3
        For i = 5 To .Cells(Rows.Count, "A").End(xlUp).Row
            
            **Cells(sat, "C") = Set MyPict = ActiveSheet.Pictures.Insert(yol)** ' this is error line
            Cells(sat, "E") = .Range("A4")
            sat = sat + 1
            Cells(sat, "E") = .Cells(i, st1)
            sat = sat + 4
            Cells(sat, "C") = .Range("B4")
            Cells(sat, "D") = .Range("C4")
            Cells(sat, "E") = .Range("D4")
            sat = sat + 1
            Cells(sat, "C") = .Cells(i, st2)
            ' sat = sat + 1
            Cells(sat, "D") = .Cells(i, st3)
            ' sat = sat + 1
            Cells(sat, "E") = .Cells(i, st4)
            sat = sat + 4
            
        Next i
    End With
    
End Sub

图片插入完成，但添加的图片数量与所选单元格中的记录数一样多。它没有添加到我指定的单元格中。

尝试制作这个标签：

Answer 1

我可能会这样做：

Sub etiket()

    Dim i As Long, st1 As Byte, st2 As Byte, st3 As Byte
    Dim st4 As Byte
    
    Dim yol As String
    yol = "C:\Users\pc\Desktop\labelexample\logo.jpg"

    Sheets("etiket").Select
    Range("A3:A" & Rows.Count).ClearContents
    
    st1 = 1: st2 = 2: st3 = 3: st4 = 4
    
    With Sheets("veri")
        sat = 3
        For i = 5 To .Cells(Rows.Count, "A").End(xlUp).Row
            
            ActiveSheet.Pictures.Insert(yol).select ' this is error line
            Selection.ShapeRange.Top = Cells(sat, "C").Top
            Selection.ShapeRange.Left = Cells(sat, "C").Left

            Cells(sat, "E") = .Range("A4")
            sat = sat + 1
            Cells(sat, "E") = .Cells(i, st1)
            sat = sat + 4
            Cells(sat, "C") = .Range("B4")
            Cells(sat, "D") = .Range("C4")
            Cells(sat, "E") = .Range("D4")
            sat = sat + 1
            Cells(sat, "C") = .Cells(i, st2)
            ' sat = sat + 1
            Cells(sat, "D") = .Cells(i, st3)
            ' sat = sat + 1
            Cells(sat, "E") = .Cells(i, st4)
            sat = sat + 4
            
        Next i
    End With
    
End Sub

如果我正确理解你的代码，那么这将添加一个徽标，并将其移动到“C”的位置并坐在左上角。
如果您愿意，您可以添加一些像素，如下所示：

            ActiveSheet.Pictures.Insert(yol).select ' this is error line
            Selection.ShapeRange.Top = Cells(sat, "C").Top + 5
            Selection.ShapeRange.Left = Cells(sat, "C").Left + 5