Excel VBA voor pop-up afbeelding

[chevy93]

Hoi,

Ik heb inmiddels al een aantal jaren een Excel-bestand waarin ik mijn Top 250 (favoriete nummers) bij houd.
Recentelijk ben ik overgestapt van de doorsnee Excel-formules naar de versie met macro's/VBA.

Dit is een wereld die echter nog nieuw voor mij is, dus ik ben nog zoekende.

Inmiddels ben ik bezig om afbeeldingen toe te voegen aan mijn nummers, zodat ik de (single)hoes als pop-up krijg.
Dit werkt via een opmerking en dan wordt via een macro de afbeelding ingevoegd.

Ik loop echter tegen een aantal problemen aan:
- Ik krijg regelmatig foutmeldingen (bv. omdat het geen .jpg, maar een .jpeg is). Ik zou graag de formule zo ombouwen dat hij na een foutmelding niet beëindigd, maar doorgaat met de volgende.
- Een andere foutmelding die ontstaat, is doordat er soms al een opmerking in de cel geplaatst is. Ik zou graag hebben dat een eventuele aanwezige opmerking eerst verwijderd wordt en vervolgens de nieuwe opmerking geplaatst wordt.
- Ik heb nummers waarin een teken als / of ? staat, maar deze kan ik in Windows niet in de bestandsnaam opnemen. Ik zou graag iets in de formule opnemen dat bepaalde tekens, zoals / en ?, genegeerd moeten worden.

Ter verduidelijking staat hier het bestand: https://www.dropbox.com/s/mf7ycsawr2ghoqh/Chevy Top 250.xlsm

Dit is de code zoals die nu is:

Sub AddABunch()
For Each cell In Selection
MyPic = "C:\Users\Chevy\Pictures\Top250\" & cell.Value & ".jpg"
With cell.AddComment
.Shape.Fill.UserPicture MyPic
.Shape.Height = 200
.Shape.Width = 200
End With
Next cell
End Sub

 

[edmoor]

Probeer het eens zo:

Sub AddABunch()
    For Each cell In Selection
        mypic = "C:\Users\Chevy\Pictures\Top250\" & cell.Value & ".jpg"
        If Dir(mypic) <> "" Then
            With cell.AddComment
              .Shape.Fill.UserPicture mypic
              .Shape.Height = 200
              .Shape.Width = 200
            End With
        End If
    Next cell
End Sub

 

[chevy93]

Bedankt voor het snelle reageren.

Ik probeer er alleen achter te komen welk deel van mijn vraag deze extra regel precies oplost.

gr,
Chevy

 

[edmoor]

Het gedeelte waarin je zegt dat de procedure ondanks dat een plaatje niet bestaat gewoon moet doorgaan.

 

[chevy93]

Merci. Dat gedeelte werkt nu perfect!

Hopelijk kan iemand mij nog helpen met het derde punt:
- Ik heb nummers waarin een teken als / of ? staat, maar deze kan ik in Windows niet in de bestandsnaam opnemen. Ik zou graag iets in de formule opnemen dat bepaalde tekens, zoals / en ?, genegeerd moeten worden.

 

[edmoor]

Je hebt dus in een cel bijvoorbeeld leuk/liedje?van staan en dan moet er worden gezocht naar leukliedjevan.jpg?

 

[chevy93]

Ja, precies.

 

[edmoor]

Probeer dit eens:

Sub AddABunch()
    For Each cell In Selection
        mypic = "C:\Users\Chevy\Pictures\Top250\" & StripChars(cell.Value) & ".jpg"
        If Dir(mypic) <> "" Then
            With cell.AddComment
              .Shape.Fill.UserPicture mypic
              .Shape.Height = 200
              .Shape.Width = 200
            End With
        End If
    Next cell
End Sub

Function StripChars(p1 As String)
    Dim i As Integer
    For i = 1 To Len(p1)
        Select Case Mid(p1, i, 1)
            Case "/", "?"
            Case Else
                StripChars = StripChars & Mid(p1, i, 1)
        End Select
    Next i
End Function

 

[chevy93]

Heel erg bedankt! :thumb:

Ik ben weer een stapje dichterbij.

 

[edmoor]

Veel plezier ermee
Ik heb de StripChars functie nog iets aangepast. Er stond een Loop teveel in.