# images to fill the cells



## KlausW (Nov 23, 2022)

Hi
I have some images that are automatically inserted into cells on different sheets with this code. This works perfectly. Now I would like a Marco for the images to fill the cells.
Anyone who can help?
Any help will be appreciated.
Best Regards Klaus W
Code to insert images looks like this.


```
ub Find()
    Dim A, B, c, d As Range ' a = området på "Billeder 1.deling med navne på foto, b = område i "Billeder" med navne på billeder, c = de enkelte celler i a, d = de enkelte celler i b
    ActiveSheet.Pictures.Delete ' de gamle billeder slettes
    Set A = Range("a4:d4,a8:d8,a12:d12,a16:d16,a20:d20") ' a defineres
    Set B = Worksheets("Billeder").Range("a4:L12") ' b defineres
    For Each c In A
        For Each d In B
            If c = d And c <> "" Then ' der testes om de enkelte celler i a findes i b
                d.Offset(-1, 0).Copy Destination:=c.Offset(-1, 0) ' hvis de findes, kopieres cellen ovenover i "Billeder" til cellen ovenover i "Billeder 1.deling"
            End If
        Next
    Next
    
   
     
End Sub
```


----------



## MCLIFTO8 (Dec 4, 2022)

Do you mean size the image so that it fits within the bounds of the cell you paste it into?


----------



## KlausW (Sunday at 3:43 PM)

sorry for the late reply.  yes, that's how I'd like it.  and maybe one or two millimeters between images and the edge of the cells.


----------



## MCLIFTO8 (Sunday at 5:58 PM)

Try this.


```
Sub Find()
    Dim A, B, c, d As Range ' a = området på "Billeder 1.deling med navne på foto, b = område i "Billeder" med navne på billeder, c = de enkelte celler i a, d = de enkelte celler i b
    ActiveSheet.Pictures.Delete ' de gamle billeder slettes
    Set A = Range("a4:d4,a8:d8,a12:d12,a16:d16,a20:d20") ' a defineres
    Set B = Worksheets("Billeder").Range("a4:L12") ' b defineres
    For Each c In A
        For Each d In B
            If c = d And c <> "" Then ' der testes om de enkelte celler i a findes i b
                d.Offset(-1, 0).Copy Destination:=c.Offset(-1, 0) ' hvis de findes, kopieres cellen ovenover i "Billeder" til cellen ovenover i "Billeder 1.deling"
                ResizePic(c.Offset(-1, 0).Address)
            End If
        Next
    Next
End Sub

Sub ResizePic(rngPicLocation As String)
   Const margin = 10 'margen
   Dim picCurrentPic As Picture
   Dim rngCell As Range

For Each picCurrentPic In ActiveSheet.Pictures
    If picCurrentPic.TopLeftCell.Address = Range(rngPicLocation).Address Then
        Set rngCell = picCurrentPic.TopLeftCell
        'picCurrentPic.LockAspectRatio = msoFalse
        picCurrentPic.Top = rngCell.Top + margin
        picCurrentPic.Left = rngCell.Left + margin
        picCurrentPic.Width = rngCell.Width - 2 * margin
        'picCurrentPic.Height = rngCell.Height - margin
    End If
Next picCurrentPic

End Sub
```

I have tested the ResizePic subroutine.
I'm not able to test it within your code but I've made a guess on where and how you would call it.

call it with "ResizePic("A1")"
set your margins with "margin = 10"


----------



## jolivanes (Sunday at 6:48 PM)

```
Dim A, B, c, d As Range
```
At the above, A, B and c are variants.
It should be

```
Dim A As Range, B As Range, c As Range, d As Range
```
See here for more.








						VBA Dim - A Complete Guide - Excel Macro Mastery
					

This post provides a comprehensive guide to using the VBA Dim statement. The quick guide table shows you the format of the DIm statement and all the ways it can be used.




					excelmacromastery.com
				



#5. How to Use Dim with Multiple Variables


What is in the cells in A? Range A is 20 cells.
What is in the cells in B? Range B is 108 cells


----------

