Afbeelding laten zien bij invoeren naam afbeelding in cel

[h3nkehv]

Goedemiddag,

Op de volgende website vond ik een bestand welke een VBA code bevat welke ik nodig heb voor mijn bestand.
http://www.mcgimpsey.com/excel/lookuppics.html
(onderaan staat example workbook, dat is de link om het excel bestand te openen, ik kon deze niet uploaden hier ivm groter dan 100kb)

Het werkt als volgt:
In het drop down menu op sheet 1 wordt een naam geselecteerd. Aan de hand van deze naam komt een afbeelding naar voren.
In sheet 2 staan de namen in kolom 1, in kolom 2 staan namen van afbeeldingen.

Met de functie vert.zoeken wordt de naam van de afbeelding in cel F1 weergeven op sheet 1.
De VBA code zoekt nu automatisch naar de afbeelding, overeenkomstig met de naam in cel F1 en maakt alle andere afbeeldingen onzichtbaar.

Nu wil ik de VBA code van dit bestand laten werken in een nieuw excel bestand (uitvoeringsbestand).
Ik heb 3 afbeeldingen ingevoerd (afbeelding 1 t/m 3) op blad 1 (en oogje uitgezet onder selectie en zichtbaarheid -> vormen op dit blad).
Door handmatig in cel A1 de tekst "Afbeelding 1" in te voeren wil ik dat de code werkt en afbeelding 1 tevoorschijn komt, echter werkt deze niet.

Hoe krijg ik deze code werkend? Na iedere calculatie zou hij volgens mij al op moeten starten omdat onderstaande erin staat:
Private Sub Worksheet_Calculate()

Iemand enig idee wat ik fout doe?
Bekijk bijlage Uitvoeringsbestand.xlsm
Alvast bedankt!

 

[edmoor]

Gebruik deze:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oPic As Picture
    Me.Pictures.Visible = False
    With Target
        For Each oPic In Me.Pictures
            If oPic.Name = .Value Then
                oPic.Visible = True
                oPic.Top = .Top
                oPic.Left = .Left
                Exit For
            End If
        Next oPic
    End With
End Sub

Overigens heten die plaatjes niet Afbeelding maar Picture. en die kan je ook direct benaderen, dus zonder die For loop.

 

[h3nkehv]

Hoi Edmoor,

Dank voor je hulp.
Als ik in mijn grotere bestand waar ik dit wil invoeren de code plaats en de afbeeldingen (20 stuks) de namen Picture 1 - 20 geef krijg ik de volgende foutmelding:
For Each oPic In Me.Pictures
Wat geeft deze zin exact aan?

Als ik de code test in een leeg bestand werkt hij, maar indien ik dit bij meer dan 6 stuks afbeeldingen probeer weergeeft hij alles boven de 6 niet meer.
Daaronder laat hij de afbeeldingen wel zien.
Enig idee hoe dit zou kunnen?

Alvast bedankt!

 

[edmoor]

De code is goed dus dat zou ik graag eens in je testbestand willen zien, met meer dan 6 afbeeldingen dus.
Dat aantal staat er overigens los van.

De zin For Each oPic In Me.Pictures betekent:
"Voor elk plaatje in het huidige werkblad"

 

[HSV]

De code in werkbladmodule van toepassing plaatsen ipv een standaard module (het is een change-event).
In een standaardmodule kent Vba de functie 'Me' niet.
'Me' staat in dit geval voor activesheet.

 

[h3nkehv]

Dag heren,

@edmoor; Ik kan het bestand helaas niet uploaden ivm meer dan 100kb, ook in zip is hij nog rond de 450kb. Enig idee hoe hier een uitzondering op gemaakt kan worden?

@HSV de code staat al in het werkblad Blad1 (blad1) die van toepassing is of bedoel je deze module niet? zo niet waar kan ik degene vinden die jij bedoelt?

 

[edmoor]

Sla je bestand op als .xlsb bestand, dan kan je hem wel uploaden.

 

[h3nkehv]

Dank u, bij deze het bestand.

Bekijk bijlage Uitvoeringsbestand.xlsb

 

[JeanPaul28]

Na het bewerken van je bestand is het te groot geworden, zelfs in zip formaat, dus kan het langs deze weg niet posten

 

[VenA]

In sheet 2 staan de namen in kolom 1, in kolom 2 staan namen van afbeeldingen.

Waarom staan deze dan niet in het voorbeeldbestand?

Edit

Zelf maar even iets gemaakt.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$1" Then
    Me.Pictures.Visible = False
    With Me.Shapes(Sheets(2).Columns(1).Find(Target.Value, , xlValues, xlWhole).Offset(, 1))
        .Visible = True
        .Top = Target.Top
        .Left = Target.Offset(, 2).Left
    End With
End If
End Sub

 

[HSV]

Code van @edmoor werkt hier perfect in het geplaatste bestand.

 

[VenA]

Hier wat minder.

Sub VenA()
For Each p In Sheets(1).Pictures
    c00 = c00 & p.Name & Chr(10)
Next p
MsgBox c00
For Each s In Sheets(1).Shapes
    If s.Type = 13 Then c01 = c01 & s.Name & Chr(10)
Next s
MsgBox c01
End Sub

Pictures.name geeft dubbele waarden in het voorbeeldbestand. De naam van de Shape op vragen geeft wel een unieke naam.

 

[HSV]

Ik zie het probleem niet.
Hooguit een spatie.