• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Afbeelding toevoegen op basis van voorwaarde

Status
Niet open voor verdere reacties.

Peer44

Gebruiker
Lid geworden
25 jan 2008
Berichten
224
Hallo,

ik probeer om automatisch een afbeelding toe te voegen aan een werkblad.
als het benoemd bereik "aantalAuto" niet 0 is, wil ik in het bereik "auto" een afbeelding plaatsen van een auto.
hetzelfde geldt voor fiets.

Heb een voorbeeldbestand toegevoegd.

met onderstaande code werkt het (nog) niet.
Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)


If Range("aantalAuto") = Not 0 Then
ActiveSheet.Range("auto").Picture.Insert ("C:\.....\auto.jpg")
'de afbeelding moet komen op de locatie E14'

End If

If Range("aantalFiets") = Not 0 Then
ActiveSheet.Range("fiets").Picture.Insert ("C\...............fiets.jpg")
'de afbeelding moet komen op de locatie d14'

End If

End Sub

Hopelijk kunnen julle me verder helpen....
 

Bijlagen

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sShape As Shape
If Range("aantalAuto") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C\...............auto.jpg", _
                        msoFalse, msoCTrue, Range("auto").Left + 2, Range("auto").Top + 2, 275, 178)
End If
If Range("aantalFiets") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C\...............fiets.jpg", _
                        msoFalse, msoCTrue, Range("fiets").Left + 2, Range("fiets").Top + 2, 213, 178)
End If
End Sub
 
Krijg met onderstaande code de volgende melding:

Compileerfout: Syntaxisfout

in dit geval is deze regel geselecteerd:
Code:
Set sShape = ActiveSheet.Shapes.AddPicture("C:\pepernoot.jpg",

volledige code:

Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim sShape As Shape
If Range("aantalAuto") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C:\sinterklaas.jpg", _
                        msoFalse, msoCTrue, Range("auto").Left + 2, Range("auto").Top + 2, 275, 178)
End If
If Range("aantalFiets") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C:\pepernoot.jpg",
                        msoFalse, msoCTrue, Range("fiets").Left + 2, Range("fiets").Top + 2, 213, 178)
End If
End Sub
 
Rudi alvast bedankt!

met onderstaande code werkt het. Maar wil nog een kleine uitbreiding toevoegen....

Code:
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim sShape As Shape
If Range("aantalAuto") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C:\auto.jpg", _
                        msoFalse, msoCTrue, Range("auto").Left + 2, Range("auto").Top + 2, 275, 178)
End If
If Range("aantalFiets") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C:\fiets.jpg", _
                        msoFalse, msoCTrue, Range("fiets").Left + 2, Range("fiets").Top + 2, 213, 178)
End If
End Sub

Wanneer echter de range van fiets of auto weer terug op 0 gezet wordt blijft de afbeelding staan, hoe kan ik ervoor zorgen dat deze dan ook weer verdwijnt?
 
Laatst bewerkt:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sShape As Shape
On Error Resume Next
If Range("aantalAuto") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C:\auto.jpg", _
                        msoFalse, msoCTrue, Range("auto").Left + 2, Range("auto").Top + 2, 275, 178)
    sShape.Name = "afbauto"
ElseIf Range("aantalAuto").Value = 0 Then
    ActiveSheet.Shapes("afbauto").Delete
End If
If Range("aantalFiets") <> 0 Then
    Set sShape = ActiveSheet.Shapes.AddPicture("C:\fiets.jpg", _
                        msoFalse, msoCTrue, Range("fiets").Left + 2, Range("fiets").Top + 2, 213, 178)
    sShape.Name = "afbfiets"
ElseIf Range("aantalFiets").Value = 0 Then
    ActiveSheet.Shapes("afbfiets").Delete
End If
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan