Maken Opdrachtknop voor invoegen van afbeelding in een cel

[Woollenhippo]

Allen,

Persoonlijk zit ik met een korte maar vervelende vraag:

Is er een mogelijkheid dat men een knop kan invoeren in een cel waaraan een opdracht gekoppeld is om een afbeelding in te voegen in deze cel? Zodat er wanneer er op deze knop gedrukt wordt, verkenner wordt geopend en men zo de gewenste afbeelding kan selecteren en ‘OK’ drukken?
Zo zou ik mijn excel-blad willen vereenvoudigen.

Heeft iemand hier ervaring mee of dit kan? Hoe dit werkt?
Persoonlijk ben ik niet thuis in de wereld van het programmeren.

Uitkijkend naar jullie reacties!

 

[alphamax]

Uit de oude doos.
Toets (linker)ALT+F11 voor de code.
Met F8 kan je stap voor stap door de code lopen (debuggen).

Je zal toch iets van programmeren moeten leren om deze code aan te kunnen passen.
We willen je graag helpen, maar gaan niet alles voordoen.

 

[Woollenhippo]

Geen probleem, ik wil zeker iets bijleren.
Ik ga er mee aan de slag, bedankt voor de start.

 

[JEC.]

Heb de code van alphamax iets aangepast voor je. Zou nu ongeveer moeten zijn zoals je wil. Wel even aangeven waar je de foto wilt hebben, zoals aangegeven in de code.

Sub jec_Alphamax()
 Dim cl, objShape
 Set cl = Sheets(1).Range("E11")   'de cel waar je de foto wil
 
 For Each objShape In Sheets(1).Shapes
   If objShape.Type = 13 Then objShape.Delete
 Next
 
 With Application.FileDialog(3)
    If .Show Then
       With Sheets(1).Pictures.Insert(.SelectedItems(1))
          .Top = cl.Top
          .Left = cl.Left
         If .Height / .Width < cl.Height / cl.Width Then
            .Height = .Height * cl.Width / .Width
            .Width = cl.Width
         Else
            .Height = cl.Height
            .Width = .Width * cl.Height / .Height
         End If
     End With
   End If
 End With
End Sub

 

[JEC.]

Kan ook nog zo

Sub jec()
 Dim cl, objShape
 Set cl = Sheets(1).Range("E11")   'de cel waar je de foto wil
 
 For Each objShape In Sheets(1).Shapes
   If objShape.Type = 13 Then objShape.Delete
 Next
 
 With Application.FileDialog(3)
   If .Show Then Sheets(1).Shapes.AddPicture .SelectedItems(1), False, True, cl.Left, cl.Top, cl.Width, cl.Height
 End With
End Sub

 

[snb]

Of zó:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Application.Dialogs(342).Show
  Cancel = True
End Sub