I would like to copy Picture in Cell not sheet?

[Venterpj1]

I'm pretty new to Macros and userforms
I would like to add a picture in a cell (That is loaded from a userform), if possibly re size it so all the pictures are more or less (In Kb) the same size and that they also look uniform (In the cells / Range)
Then also save an original copy of the picture in a folder so I can reference / call back the original picture in full quality, on a later stage.

This is what i have so far:

Private Sub CommandButton4_Click()
Dim fileToOpen As Variant
Sheets("Backup").Select
fileToOpen = Application _
.GetOpenFilename("All Picture Files (*.jpg;*.gif;*.bmp;*.tif),*.jpg;*.gif;*.bmp;*.tif")
If fileToOpen <> False Then
Me.Image1.Picture = LoadPicture(fileToOpen)
Image1.PictureSizeMode = fmPictureSizeModeStretch
Me.Repaint
Image1.Visible = True
Set pic = ActiveSheet.Shapes.AddPicture(Filename:=fileToOpen, _
LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
End If
End Sub




Any assistance will be greatly appriciated

 

[Venterpj1]

[COLOR=#333333]Private Sub CommandButton4_Click()[/COLOR]
[COLOR=#333333]Dim fileToOpen As Variant[/COLOR]
[COLOR=#333333]Sheets("Backup").Select[/COLOR]
[COLOR=#333333]fileToOpen = Application _[/COLOR]
[COLOR=#333333].GetOpenFilename("All Picture Files (*.jpg;*.gif;*.bmp;*.tif),*.jpg;*.gif;*.bmp;*.tif")[/COLOR]
[COLOR=#333333]If fileToOpen <> False Then[/COLOR]
[COLOR=#333333]Me.Image1.Picture = LoadPicture(fileToOpen)[/COLOR]
[COLOR=#333333]Image1.PictureSizeMode = fmPictureSizeModeStretch[/COLOR]
[COLOR=#333333]Me.Repaint[/COLOR]
[COLOR=#333333]Image1.Visible = True[/COLOR]
[COLOR=#333333]Set pic = ActiveSheet.Shapes.AddPicture(Filename:=fileToOpen, _[/COLOR]
[COLOR=#333333]LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]End Sub[/COLOR]