Afbeelding in cel

[martindeboer1988]

Beste forumleden,

Ik probeer in Excel op basis van een celwaarde een externe afbeelding in te laden.
Elke keer als de cel wijzigt moet de afbeelding ook wijzigen.
Zelf kom ik helaas niet verder als onderstaand.

Sub test()
'
' test Macro
'

'
    ActiveSheet.Pictures.Insert("http://fz-qwe.office.intern/foto/500512.jpg"). _
        Select
End Sub

 

[edmoor]

Met in A1 de naam van de foto, in dit geval dus 500512:

Sub test()
    Dim pct As String
    pct = "http://fz-qwe.office.intern/foto/" & Range("A1") & ".jpg"
    ActiveSheet.Pictures.Insert(pct).Select
End Sub

In plaats van de naam test() in een Module zou je dan de code achter het werkblad moeten plaatsen zoals hier:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$1" Then
        Dim pct As String
        pct = "http://fz-qwe.office.intern/foto/" & Range("A1") & ".jpg"
        ActiveSheet.Pictures.Insert(pct).Select
    End If
End Sub

 

[martindeboer1988]

De code werkt alleen heb ik nog twee issues hiermee...

- Kan ik ook bepalen waar de afbeelding verschijnt ?
- wanneer ik cel A1 leeg maak krijg ik een run time error 1004 "unable to get the insert property of the pictures class"

 

[edmoor]

- Uiteraard krijg je een foutmelding als de cel leeg is, dus daar moet je op controleren.
- Een picture is een shape object met z'n eigen methoden en attributen. Daar kan je mee spelen om het plaatje de gewenste grootte te geven en op de gewenste plek te zetten.

Beide zijn hier in verwerkt:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pct As String

    If Target.Address = "$A$1" And Target.Value <> "" Then
        pct = "http://fz-qwe.office.intern/foto/" & Range("A1") & ".jpg"
        With ActiveSheet.Pictures.Insert(pct)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Width = 75
                .Height = 100
            End With
            .Left = 100
            .Top = 100
            .Placement = 1
            .PrintObject = True
        End With
    End If
End Sub