afbeelding toevoegen

[vincentsp]

Hoi,

Ben nieuw hier en thuis druk bezig om een macro te maken, nu heb ik al een hoop problemen op kunnen lossen door hier het forum door te lopen maar heb zo toch nog iets waar ik zo niet uit kom.
Heb op een code gevonden zodat ik een afbeelding uit bestand kan invoegen in mijn excel bestand, hierbij worden afbeeldingen die eerder in de desbetrefende cel stonden verwijderd. Tot hier allemaal perfect de afbeelding word alleen te klein gemaakt en zou juist in verhouding de volledige grote van de cel moeten innemen. Hopelijk is dit simpel op te lossen. Bijvoorbaad dank.

Vincent.


Private Sub CommandButton5_Click()

Dim ImageCell As Range
Dim rH As Double, rW As Double
Dim fH As Double, fW As Double
Dim fMod As Double

Set ImageCell = Range("H16").MergeArea
rH = ImageCell.Height: rW = ImageCell.Width

On Error Resume Next
ActiveSheet.Shapes(MY_PIC).Delete
On Error GoTo 0

' Open "Insert Picture" pop-up window
Application.Dialogs(xlDialogInsertPicture).Show
' exit if selection is not a picture
If TypeName(Selection) <> "Picture" Then Exit Sub

fH = Selection.Height / rH
fW = Selection.Width / rW
fMod = IIf(fH > fW, fH, fW)

'Size the image selection to full merged cell size
With Selection
.Left = ImageCell.Left
.Top = ImageCell.Top
.Width = .Width / fMod
.Height = .Height / fMod
.Placement = xlMoveAndSize
End With

End Sub

 

[snb]

Dit lijkt me simpeler:
Plaatst een celvullend plaatje op de positie van cel K2.
(Toelichting: in Excel kunnen cellen geen plaatjes bevatten; werkbladen wél. Een plaatje kan op dezelfde positie worden gezet als een cel, zodat het lijkt alsof het plaatje in de cel zit (quod non); als de omvang van het plaatje bovendien wordt gekoppeld aan de omvang van de cel versterkt dat die indruk.)

Sub tst()
  For Each pt In Blad1.Pictures
    If pt.Top & pt.Left = [K2].Top & [K2].Left Then pt.Delete
  Next
  With Blad1.Pictures.Insert("E:\foto\voorbeeld.bmp")
    .Top = [K2].Top
    .Left = [K2].Left
    .Width = [K2].Width
    .Height = [K2].Height
    .Placement = xlMoveAndSize
  End With
End Sub

PS. Ik denk dat je grootte, bedoelde en bij voorbaat.

 

[Wigi]

PS. Ik denk dat je grootte, bedoelde en bij voorbaat.

En:

de afbeelding wordT alleen te klein gemaakt