Image url via verticaal zoeken

[RichieL]

Goedemorgen,

Ik al gezocht naar evt oplossingen, maar kan niet echt wat passend vinden.

Is het met excel / "verticaal zoeken" met behulp van een url mogelijk om een image op te roepen?
Informatie wordt opgehaald uit tablad "Total". Zoekwaarde is het nr.


Ik heb een voorbeeld bestandje erbij gedaan.

Wie zou mij een duwtjes in de goede richting kunnen geven?

 

[wds]

Om je in gang te steken...

Sub URLPictureInsert()
    Dim Pshp As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("A2:h3")
    For Each cell In Rng
        filenam = cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Pshp = Selection.ShapeRange.Item(1)
        If Pshp Is Nothing Then GoTo lab
        xCol = cell.Column + 1
        Set xRg = Cells(cell.Row, xCol)
        With Pshp
            .LockAspectRatio = msoFalse
            .Width = 100
           .Height = 100
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width) / 2
        End With
lab:
    Set Pshp = Nothing
    Range("A2").Select
    Next
    Application.ScreenUpdating = True
End Sub

 

[HSV]

Onderstaande code In baldmodule 'per product'.

Bij wijzigen van cel C1 gaat de code in werking.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s00 As String
If Target.Address = "$C$1" Then
   On Error Resume Next
       Shapes("Afbeelding 1").Delete
s00 = Range("H3").Value
    Shapes.AddPicture s00, -1, -1, Columns(8).Left, Rows(3).Top, 190, 120
    Shapes(Split(s00, "/")(UBound(Split(s00, "/")))).Name = "Afbeelding 1"
 End If
End Sub

 

[RichieL]

@HSV: Wat bedoel je met: Onderstaande code In baldmodule 'per product'.?

 

[VenA]

Een change event moet je in de module van het betreffende blad zetten. Dus de code in #3 even plaatsen in de de juiste module en dan even testen. Of het hoofdstuk even lezen over verschillende modules die er bestaan in Excel VBA.

 

[snb]

Mag dit ook ?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$C$1" Then
    On Error Resume Next
    Shapes("Afbeelding 1").Delete

    Shapes.AddPicture(Range("H3").Value, -1, -1, Columns(8).Left, Rows(3).Top, 190, 120).Name = "Afbeelding 1"
  End If
End Sub

 

[HSV]

Dat mag.

 

[RichieL]

Bedankt voor de reacties.
Ik kom er nog niet helemaal uit. Ga mijzelf even inlezen in "baldmodule"

 

[VenA]

Een baldmodule bestaat niet. Is een typefoutje van HSV. Uit de handtekening van #6 http://www.snb-vba.eu/VBA_Excel_VBproject.html#L_2

 

[RichieL]

Ik heb hem werkende gekregen. Bedankt!

 

[RichieL]

Hoe kan ik de image meer in de cel krijgen, dus meer gecentreerd?

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$C$1" Then
    On Error Resume Next
    Shapes("Afbeelding 1").Delete

    Shapes.AddPicture(Range("H3").Value, -1, -1, Columns(8).Left, Rows(3).Top, 190, 120).Name = "Afbeelding 1"
  End If
End Sub

 

[HSV]

Beetje oefenen met de rode getallen door ze te verhogen cq te verkleinen.

Columns(8).Left, Rows(3).Top, 190, 120

 

[RichieL]

Hallo HSV,

de grootte van de image was me gelukt. Het enige wat me niet lukt is de positie in de cel. Nu wordt de image linksboven in de hoek geplaatst, maar ik wil graag dat de image meer naar rechts (in het midden) geplaatst wordt. Dus in het midden uitgelijnt en in het midden gecentreerd. Zie bijgevoegde foto.

de linkse foto = zoals hij nu wordt geplaatst
de rechter foto = zoals ik het graag zou willen hebben.



Alvast bedankt!

 

[HSV]

Hallo,

Bv.

Columns(8).Left [COLOR=#ff0000]+ 10[/COLOR], Rows(3).Top [COLOR=#ff0000]+ 5[/COLOR]

 

[RichieL]

haha, te simpel :shocked:
Ik zat denk te moeilijk te denken

Bedankt!