Foto koppelen met inhoud combobox

[sep33]

Hey Excel-Vba experten,

Ik heb een userform gemaakt waarin een combobox(dropdown) en een "afbeelding toevoegknop" zich bevinden. In de combobox kan er een naam gekozen worden, die dan achteraf in het Excel document geplaatst wordt.
Als er op de "afbeelding toevoegknop" gedrukt wordt, wordt er direct verwezen naar het pad "C\afbeeldingen" waar dan gekozen worden uit foto's die dezelfde namen bevatten als in de eerder vernoemde combobox. Indien er een foto geselecteerd wordt, wordt deze foto automatisch op grootte gesneden en neemt ook de op voorhand bepaalde plaats in het Excel document in.

Nu zou ik graag de 'afbeelding toevoegknop' weglaten en zorgen dat als er een naam in de Combobox geselecteerd is, die foto automatisch uit de desbetreffende map gehaald wordt.
Ik heb de code van de 'afbeelding toevoegknop' en de combobox al, ik zoek dus alleen nog een manier om de naam met de afbeelding in de map te linken.
Zelf ben ik geen expert in dit alles, maar het is mijn opdracht dit te volbrengen en hoop hierin nog verder te groeien.

Heeft iemand hiervoor toevallig tips?
Hier hebben jullie alvast een voorbeeld bestand:
Bekijk bijlage Foto's linken.xlsm

Op dit ogenblik ben ik zelf aan het experimenteren met de naam als variabele te gebruiken samen met de functie 'Case'. Maar dit werkt voorlopig nog niet zo goed.

Alvast hartelijk bedankt!!!!

Mvg,

Seppe


Voor de mensen dit het voorbeeld bestand niet willen downloaden, hieronder zit de code van het Userform in het voorbeeldbestand.

Private Sub CommandButton1_Click()
Dim sPicture As String, Pic As Picture

ChDir "C:\Afbeeldingen"             [COLOR="#008000"]'Ga direct naar de map afbeeldingen, om hierin een foto HANDMATIG te selecteren[/COLOR]
ActiveSheet.Unprotect
sPicture = Application.GetOpenFilename _
    ("Pictures (*.gif; *.jpg; *.bmp; *.tif), *.gif; *.jpg; *.bmp; *.tif", _
     , "Select Picture to Import") [COLOR="#008000"]'geef aan welke bestandtypes allemaal geopend mogen worden.
 [/COLOR]
If sPicture = "False" Then Exit Sub
OldShapes1                          [COLOR="#008000"]'Verwijder de oude foto(zie subprogramma "Sub OldShapes1" hieronder).[/COLOR]
Range("A10").Select                 [COLOR="#008000"]'Plaats bepalen[/COLOR]
ActiveSheet.Pictures.Insert(sPicture).Select    'Voeg de foto in
    With Selection                             [COLOR="#008000"] 'bepaal de grote en de opmaak van de foto.[/COLOR]
    .ShapeRange.LockAspectRatio = msoFalse
    .Height = 150 '42.5
    .Width = 260 '85
    .Top = ActiveCell.Top
    .Left = ActiveCell.Left
    .Placement = xlMoveAndSize
    .ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromBottomRight
    .ShapeRange.ScaleHeight 0.97, msoFalse, msoScaleFromBottomRight
    .ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
    .ShapeRange.ScaleWidth 0.96, msoFalse, msoScaleFromTopLeft
    
    Selection.Name = "ActiefPicture1"           [COLOR="#008000"]'Geef de foto de naam "ActiefPicture1" om hem achteraf goed te kunnen verwijderen[/COLOR]
    ActiveCell.Select
    Range("b7").Select
    
End With
End Sub
Sub OldShapes1()                                [COLOR="#008000"]'Subprogramma OldShapes1[/COLOR]
    Dim ashp As Shape
    
    For Each ashp In ActiveSheet.Shapes
        Debug.Print ashp.Name
        If ashp.Name = "ActiefPicture1" Then        [COLOR="#008000"]'maakt het mogelijk om oude foto's te verwijderen, zodat er geen 20foto's boven elkaar komen te liggen.[/COLOR]
            ActiveSheet.Shapes("ActiefPicture1").Delete
            Exit Sub
        End If
    Next ashp
   
End Sub

[COLOR="#008000"]'OK knop[/COLOR]

Private Sub CommandButton2_Click()
Dim Namen1 As Range
Set Namen1 = Sheets("Sheet1").Cells(9, 3)

[COLOR="#008000"]'Zet de waarde in Cel B9 - koppel inhoud dropdown menu met een cel in Excel[/COLOR]
If ComboBox1.Value <> "" Then
Namen1.Value = ComboBox1.Value
End If

[COLOR="#008000"]'Sluit het venster[/COLOR]
Unload Me
End Sub

[COLOR="#008000"]'BEPALING COMBOBOX[/COLOR]
[COLOR="#008000"]'Als er één maal op het userform wordt geklikt, worden de dropdowns zichtbaar[/COLOR]
Private Sub UserForm_Click()
Dim EndRowH As Integer
Dim NamenN

EndRowH = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
NamenN = Sheets("Sheet2").Range("A2:" & "A" & EndRowH)
ComboBox1.List = NamenN
ComboBox1.ListIndex = 0
End Sub

 

[HSV]

Zet de code in de:

Private Sub ComboBox1_Change()
....................
End Sub

 

[sep33]

HSV, bedankt voor je reactie.
Ik moet inderdaad de code onder de combobox plaatsen, maar dat was niet echt het gene wat ik zocht.
Eerder zoek ik een methode/stukje code, om de naam die geselecteerd is in de combobox, te koppelen met de map waar de afbeeldingen zich bevinden.

Bijvoorbeeld mijn manier van denken(geen idee of deze manier juist is):

Inhoud combobox as NM
NM as variable

"C\afbeeldingen\NM"

Zo zou hij dus automatisch kunnen zoeken in de map afbeeldingen naar de naam in de combobox.
Het enige probleem is, dat ik nog niet zoveel ervaring heb hiermee en het me dus niet lukt om het juiste stukje code te vinden.

Alvast hartelijk bedankt!!

Mvg,

Seppe

 

[HSV]

Probeer dit bestandje eens Seppe.
Ik heb erbij geschreven wat ik heb toegevoegd.

 

[sep33]

Hey Harry, bedankt voor je reactie & moeite!

Het bijgevoegde bestandje geeft nog een foutmelding bij de code onder ComboBox1_Change:

 ActiveSheet.Image1.Picture = LoadPicture(bestandsnaam)

Ik krijg de foutmelding dat de file niet te vinden is. Toch heb ik foto's toegevoegd in de map "afbeeldingen" met de naam anne, Anne, anne1,image1 etc.
Ook heb ik al geprobeerd om een ander path toe te voegen, maar voorlopig nog zonder succes.

Misschien doe iets fout en ligt het aan een klein foutje(?)

Nogmaals bedankt voor je tijd & moeite.

mvg,

Seppe

 

[HSV]

Verander eens...

 bestandsnaam = "C:\afbeeldingen\NM\" & ComboBox1.Value & ".jpg"

in:

 bestandsnaam = "C:\afbeeldingen\" & ComboBox1.Value & ".jpg"

Of het moet al geen .jpg bestand zijn natuurlijk.

 

[huijb]

@TechnoMX De toevoeging tot de oplossing van deze vraag ontgaat de meeste van ons, daarom bericht verwijderd.

 

[sep33]

Hey Harry!
Je hebt de juiste oplossing gegeven! Hij doet het nu perfect.:thumb: Echt SUPER hard bedankt!
Veel respect!

Mvg,

Seppe