Membuat template insert gambar

  1. 8 minggu lalu

    Selamat malam mohon inspirasi bantuannya
    Saya ada data sheet Ambil Data berisi nama file(yang akan digunakan untuk insert gambar),nama merchant,mid merchant
    nah di sheet print saya ingin menampilkan ketiganya secara berurutan
    untuk data nomor 1
    cells A1 berisi nama merchant
    cells A2 berisi mid merchant
    cell A3 berisi shapes berisi gambar yg di upload berdasarkan nama file

    untuk data nomor 2
    cells B1 berisi nama merchant
    cells B2 berisi mid merchant
    cell B3 berisi shapes berisi gambar yg di upload berdasarkan nama file

    untuk data nomor 3
    cells C1 berisi nama merchant
    cells C2 berisi mid merchant
    cell C3 berisi shapes berisi gambar yg di upload berdasarkan nama file

    untuk data nomor 4
    cells A5 berisi nama merchant
    cells A6 berisi mid merchant
    cell A7 berisi shapes berisi gambar yg di upload berdasarkan nama file

    dan seterusnya..

    yang sekarang bisa di sheet barcode
    cells A1 hanya berisi nama merchant data terakhir
    cells A2 hanya berisi mid merchant data terakhir
    cell A3 hanya berisi gambar terakhir ( kalo digeser akan ada gambar dari data sebelumnya)

    alur logika yg saya miliki

    Private Const ITEM_FILL_FAILED As Long = &H80070002 ' UserPicture of object FillFormat failed
    Sub AddOlEObject()
    Dim mainWorkBook As Workbook
    Dim nmmerchant, md, nm As String
    Dim lksmid As Integer
    Set mainWorkBook = ActiveWorkbook
    Worksheets("Ambil Data").Activate
    folderpath = "C:\Users\Lenovo\Documents\KEMPEL\QR Yg Kurang Create 2 Juni 2018\KEMPEL"
    Set fso = CreateObject("Scripting.FileSystemObject")
    NoOfFiles = fso.GetFolder(folderpath).Files.Count
    counter = 1
    Set listfiles = fso.GetFolder(folderpath).Files
    For Each fls In listfiles
    strCompFilePath = folderpath & "\" & Trim(fls.Name )
    If strCompFilePath <> "" Then
    If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
    Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
    Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
    counter = counter + 1
    Worksheets("Ambil Data").Range("A" & counter).Value = fls.Name
    nm = fls.Name
    md = mid(nm, InStr(nm, "MID"), 13)
    nmmerchant = Left(nm, InStr(nm, "MID") - 1)
    Worksheets("Ambil Data").Range("B" & counter).Value = nmmerchant
    Worksheets("Ambil Data").Range("c" & counter).Value = md
    'disini dibuat for untuk membuat ke cell yang baru tapi selalu gagal karena menampilkan data yang sama saja
    Worksheets("Barcode").Range("bc.merchant") = nmmerchant
    Worksheets("Barcode").Range("bc.md") = md
    Worksheets("Barcode").Shapes("Rectangle 1").Fill.UserPicture strCompFilePath

    End If
    End If
    Next
    mainWorkBook.Save
    End Sub

  2. manweljs_

    Jun 24 Terverifikasi + 3.874 Poin
    Di sunting 8 minggu lalu oleh manweljs_

    @joe_amoeba

    ini pertanyaan sama seperti disebelah ya?

    kalau pertanyaanya adalah mengisi gambar, di forum ini ada banyak diskusi yang membahas hal ini misalnya di diskusi berikut

    namun kalau memang gambar yang ingin di tampilkan berupa QR Code, mengapa tidak dibuat langsung di file excelnya ? soalnya cara anda saya pikir tidak effisien

  3. manweljs_

    Jun 24 Terverifikasi + 3.874 Poin
    Di sunting 8 minggu lalu oleh manweljs_

    @joe_amoeba

    terlampir contohnya, semoga sesuai

    di ekstrak dulu ya :)

  4. 4 minggu lalu

    maaf gan baru bergabung..barusan di coba..mantab gan makasih banyak @manweljs_
    nambah lagi ilmunya

 

atau Mendaftar untuk ikut berdiskusi!