LoadPicture

[Neuz]

Hey Allemaal,

Ik ben op dit moment bezig om in excel met vba een "programmatje" te schrijven waar in iemand zijn/haar verzameling model auto's kan invullen.
Nu wil ik als je een de gegevens van een coureur gaat bekijken de foto van die coureur in het userform laden, tot zo ver gaat alles perfect.

Er wordt gezocht naar de foto in een lokale map. Deze laat ik aanroepen door alle coureurs die in het systeem staan in een combobox weer te geven.
Deze namen moet overeen komen met de namen van de foto's. Dit gaat ook nog goed.

Mijn vraag is nu als er van de betreffende coureur nog geen foto in de lokale map staat of ik heb per ongeluk een type foutje gemaakt in de foto naam
dat er dan een error afbeelding in het userform verschijnt op de plaats waar normaal gesproken de foto van de coureur zou verschijnen.

Ik heb al verschillende manier geprobeerd die ik hier op het forum zag langs waaien maar allemaal zonder resultaat. Mijn kennis van vba is nog niet echt
heel erg groot maar doe mijn best om alles te leren.

Kan iemand mij helpen om dit probleem op te lossen.

Ik gebruik het volgende script om alles te laten draaien:

Private Sub ComNaam_Change()
Dim oRng As Range
    Set oRng = ThisWorkbook.Sheets("Coureur").Cells.Find(what:=ComNaam.Value, lookat:=xlWhole)
    'staat nog een klein gedeelte tussen maar dat zijn de rest van de tekstvelden    

    Dim foto As Variant
    foto = "C:\Users\Neuz\Pictures\Test Ferrari\Coureur\" & ComNaam & ".jpg"
    FormCoureurBekijken.PicCoureur.Picture = LoadPicture(foto)
End Sub

Alvast bedankt voor de moeite.

Groet Neuz

 

[edmoor]

Een mogelijkheid met een extra foto:

Private Sub ComNaam_Change()
Dim oRng As Range
    Set oRng = ThisWorkbook.Sheets("Coureur").Cells.Find(what:=ComNaam.Value, lookat:=xlWhole)
    'staat nog een klein gedeelte tussen maar dat zijn de rest van de tekstvelden    

    Dim foto As Variant
    Dim GeenFoto As Variant

    GeenFoto =  "C:\Users\Neuz\Pictures\Test Ferrari\Coureur\error.jpg"
    foto = "C:\Users\Neuz\Pictures\Test Ferrari\Coureur\" & ComNaam & ".jpg"

    If Dir(foto) = "" Then
        FormCoureurBekijken.PicCoureur.Picture = LoadPicture(GeenFoto)
    Else
        FormCoureurBekijken.PicCoureur.Picture = LoadPicture(foto)
    End If
End Sub

 

[huijb]

Visual Basic is iets anders dan Visual Basic for Applications, VBA is programmeren binnen Office applicaties. Verplaatst naar juiste sectie.

 

[Warme bakkertje]

Of de 'te warm gewassen versie'

Private Sub ComNaam_Change()
Dim oRng As Range
    Set oRng = ThisWorkbook.Sheets("Coureur").Cells.Find(what:=ComNaam.Value, lookat:=xlWhole)
    'staat nog een klein gedeelte tussen maar dat zijn de rest van de tekstvelden

    Const conPad = "C:\Users\Neuz\Pictures\Test Ferrari\Coureur\"
    FormCoureurBekijken.PicCoureur.Picture = LoadPicture(conPad & IIf(Dir(conPad & ComNaam & ".jpg") = vbNullString, "error.jpg", ComNaam & ".jpg"))

End Sub

Kopiëer onderstaande afbeelding in je fotodirectory

 

[snb]

Nog iets warmer:

Private Sub ComNaam_Change()
    with ThisWorkbook.Sheets("Coureur").Cells.Find(ComNaam.Value, ,,1)
        'staat nog een klein gedeelte tussen maar dat zijn de rest van de tekstvelden
    end with

    c00= "C:\Users\Neuz\Pictures\Test Ferrari\Coureur\comnaam.value & ".jpg"
    FormCoureurBekijken.PicCoureur.Picture = LoadPicture(iIf(Dir(c00) = "", "error.jpg", c00))
End Sub

 

[Neuz]

Hey allemaal,

Bedankt voor de snelle reacties scripts is toegevoegd en werkt super.
Sla ik op en ga ik zeker nog een keer gebruiken.

Visual Basic is iets anders dan Visual Basic for Applications, VBA is programmeren binnen Office applicaties. Verplaatst naar juiste sectie.

Sorry voor het verkeerd plaatsen van deze vraag maar gelukkig is het opgelost.

Deze vraag wordt genoteerd als beantwoord.

Gr Neuz

 

[Offthefield]

Neuz,

Kan je er een klein excel-bestand opzetten,
dan heb ik een idee hoe het eruit gaat zien

Offthefield

 

[Neuz]

Bestand

Hey Offthefield,

Ik heb geen klein bestandje alleen het bestand wat ik tot nu toe heb.
Hier zit verder geen privacy gevoelige informatie tussen dus hierbij het
volledige bestand.

Bekijk bijlage Ferrari Collectie.xlsm

Groet Neuz

 

[Offthefield]

Hartelijk dank,

Ik ga het binnenkort even goed bekijken

Momenteel weinig tijd


mvrgr

Offthefield