jpg images importeren volgens waarden in een kolom

Bjorkie · 21 mrt 2018

Hoi allen,

ik ben op zoek naar een manier om jpg beeldjes, te importeren in cellen naar bepaalde artikel nummers.
de jpg bestanden hebben de zelfde naam als de artikel nummers, en staan in een aparte folder op mijn computer.
dus: ik heb een bewerking, waarbij ik een lijst met nummers bekom.
naast elk nummer wil iknu het bijpassende jpg bestandje tonen, opdat ik het dan gehele kan afdrukken.
let wel, de afbeeldingen moete ge-rescaled wordne dat ze in een vaste grootte in de cel naast de nummer komen.

??? iemand een idee?
volgende formule heb ik al getest, maar werkt niet echt goed.

Code:

sheetName = Location.Parent.Name

'Delete current picture if exists
For Each lookupPicture In Sheets(sheetName).Shapes
    If lookupPicture.Name = "PictureLookup" Then
'        lookupPicture.Delete
    End If
Next lookupPicture

'Get position of cell calling the UDF
picTop = Location.Top
picLeft = Location.Left

'Add the picture in the right location
Set lookupPicture = Sheets(sheetName).Shapes.AddPicture _
("E:\Documents\test\images\" & Value & ".jpg", msoFalse, msoTrue, picLeft, picTop, -1, -1)

'change the picture name
lookupPicture.Name = "PictureLookup"

PictureLookup = ""

End Function

Bjorkie · 22 mrt 2018

Ik heb volgende getest, maar heb 1 klein probleem.

Code:

Sub Insert_Pict1()
    Const Afb_map = "E:\Documents\test\images\"
    myarray = WorksheetFunction.Transpose(Range("C3", Range("C" & Rows.Count).End(xlUp)).Value)
    ActiveSheet.Protect False, False, False, False, False
    If Not IsArray(myarray) Then Exit Sub
    On Error Resume Next
    lRow = 1
    For lLoop = LBound(myarray) To UBound(myarray)
        Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
                Cells(1, 4).Left + 9, Cells(lRow, 1).Top + 8, 50, 30)
        lRow = lRow + 1
    Next lLoop
End Sub

met deze code importeerd de vba de beelden telkens vanaf de eerste ROW, en niet vanaf ROW3 in mijn geval.
iemand die me helpen kan,

thx

Bjorkie · 22 mrt 2018

Hey Allen,

ik heb volgend script dat mij de gewenste oplossing geeft.
(let wel, image in kolom A; referentie waarde komt uit kolom D vanaf row 3

Code:

Sub Insert_Pict2()
    Const Afb_map = "E:\Documents\test\images\"
    myarray = WorksheetFunction.Transpose(Range("D3", Range("D" & Rows.Count).End(xlUp)).Value)
    ActiveSheet.Protect False, False, False, False, False
    If Not IsArray(myarray) Then Exit Sub
    On Error Resume Next
    lRow = 3
    For lLoop = LBound(myarray) To UBound(myarray)
        Set sShape = ActiveSheet.Shapes.AddPicture(Afb_map & myarray(lLoop) & ".jpg", msoFalse, msoCTrue, _
                Cells(1, 1).Left + 9, Cells(lRow, 2).Top + 8, -1, -1)
                With sShape
                    .ShapeRange.LockAspectRatio = msoTrue
                    .Height = 25
                End With
                
        lRow = lRow + 1
    Next lLoop
End Sub

alvast bedankt voor al diegenen die iets aan het zoeken waren.
thx

jpg images importeren volgens waarden in een kolom

Bjorkie

Gebruiker

Bjorkie

Gebruiker

Bjorkie

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy