Foto toevoegen aan Userform vanaf een sheet

[matthiej88]

Hallo,

Ik ben een beetje aan het hobby-en in Excel om een adressenlijst te maken. Nieuwe personen voeg ik toe met een userform en ook wijzigingen voer ik door via hetzelfde userform. Door dubbel te klikken op de persoon wordt de userform opgeroepen.

Nu heb ik op dit userform een plek gemaakt waar ik een foto toe kan voegen. Ik wil deze foto graag invoegen in het excelbestand, zodat de foto altijd opnieuw opgeroepen kan worden. Het verplaatsen of verwijderen van de foto in een bepaalde map heeft daardoor geen negatief effect. Onderstaand de code om de foto op te halen en in de excelsheet te plaatsen. Dit werkt prima. De foto wordt weergegeven op de userform, wordt in de sheet gezet en krijgt de naam van het volgnummer in kolom A.

Private Sub AddFoto_Click()
On Error Resume Next

'Openen van het dialoogvenster
pic = Application.GetOpenFilename("Picture,*.JPG,Picture,*.JPEG,Picture,*.GIF,Picture,*.BMP")

Foto.Picture = LoadPicture(pic)
Add.Foto.PictureAlignment = 3
Add.Foto.PictureSizeMode = 3

a = Sheets("Data").Range("B4")
With Sheets("Adressen").Range("AK" & a)
    Set pic = Sheets("Adressen").Shapes.AddPicture(pic, False, True, .Width, .Height, 100, 100)
End With
With pic
    .LockAspectRatio = msoTrue
    .Name = Sheets("Adressen").Range("A" & a)
End With

End Sub

Als ik een bepaalde regel activeer moet deze foto dus weer opgeroepen worden. Hiervoor had ik onderstaande code bedacht. Dus langs alle shapes zoeken aar de shape met het unieke volgnummer in kolom A als naam. Deze wordt ook gevonden, maar het toevoegen lukt niet. De melding "Object vereist" verschijnt dan.

''Foto terughalen (heeft het unieke nr in kolom A als naam)
For Each Shape In Sheets("Adressen").Shapes
If Shape.Name = Sheets("Adressen").Range("A" & a) Then
Foto.Picture = LoadPicture(Shape.Name)
Add.Foto.PictureAlignment = 3
Add.Foto.PictureSizeMode = 3
Exit For
End If
Next

Iemand enig idee hoe ik deze foto weer kan oproepen?

Alvast bedankt!
Matthijs

 

[snb]

Dat gaat alleen maar via een omweg: de afbeelding toekennen aan een grafiek, dan als bestand opslaan en dan weer met loadpicture toekennen aan de picturecontrol in het userform.

 

[matthiej88]

Het is me toch gelukt. Ik heb de module "modPastePicture" van http://www.oaltd.co.uk/Excel/Default.htm toegevoegd. Daarna heb ik onderstaande code in mijn userform_initialize toegevoegd en dat werkt (Y).

'Foto opnieuw ophalen
Dim pic As Shape, lPicType As Long
For Each Shape In Sheets("Adressen").Shapes
If Shape.Name = Sheets("Adressen").Range("A" & a) Then

lPicType = IIf(obMetafile, xlPicture, xlBitmap)

With Shape
    .CopyPicture xlScreen, lPicType
End With
Set Add.Foto.Picture = PastePicture(lPicType)
Exit For
End If
Next

 

[snb]

Het is je niet gelukt. Dat is een gigantische omweg en wel verschrikkelijk veel code voor iets simpels.
En ik betwijfel of je die code wel begrijpt.

Wat ik aangaf kan hiermee:

Sub M_snb()
    c01 = ThisWorkbook.path & "\foto.gif"
    
    Sheets(1).Shapes(1).CopyPicture

    With Sheets(1).ChartObjects.Add(, , .Width, .Height).Chart
      .Paste
      .Export c01, "GIF"
      .Parent.Delete
    End With

    Frame1.Picture = LoadPicture(c01)
End Sub