how to make command button insert picture in range of cells and save the image for others to be able to see the image

[Dorknightz]

Hi everyone.

I'm just wondering how can I save the inserted image for other people to see from a different computer.

I have used this code.

Private Sub CommandButton1_Click()

Dim strFileName As String
Dim objPic As Picture
Dim rngDest As Range
strFileName = Application.GetOpenFilename( _
FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
Title:="Please select an image...")
If strFileName = "False" Then Exit Sub
Set rngDest = Me.Range("I22:J22")
Set objPic = Me.Pictures.Insert(strFileName)

With objPic
.ShapeRange.LockAspectRatio = msoFalse
.Left = rngDest.Left
.Top = rngDest.Top
.Width = rngDest.Width
.Height = rngDest.Height
End With

End Sub

Thank you,

Dorknightz

 

[GWteB]

Hi, Welcome to MrExcel.
See if this works for you ...

Private Sub CommandButton1_Click()

Dim strFileName As String
'Dim objPic As Picture
Dim objPic As Shape
Dim rngDest As Range
strFileName = Application.GetOpenFilename( _
FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
Title:="Please select an image...")
If strFileName = "False" Then Exit Sub
Set rngDest = Me.Range("I22:J22")
'Set objPic = Me.Pictures.Insert(strFileName)
Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

With objPic
'.ShapeRange.LockAspectRatio = msoFalse
.LockAspectRatio = msoFalse
.Left = rngDest.Left
.Top = rngDest.Top
.Width = rngDest.Width
.Height = rngDest.Height
End With

End Sub

 

[Dorknightz]

Hi, Welcome to MrExcel.
See if this works for you ...

Private Sub CommandButton1_Click()

Dim strFileName As String
'Dim objPic As Picture
Dim objPic As Shape
Dim rngDest As Range
strFileName = Application.GetOpenFilename( _
FileFilter:="Images (*.jpg;*.gif;*.png),*.jpg;*.gif;*.png", _
Title:="Please select an image...")
If strFileName = "False" Then Exit Sub
Set rngDest = Me.Range("I22:J22")
'Set objPic = Me.Pictures.Insert(strFileName)
Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

With objPic
'.ShapeRange.LockAspectRatio = msoFalse
.LockAspectRatio = msoFalse
.Left = rngDest.Left
.Top = rngDest.Top
.Width = rngDest.Width
.Height = rngDest.Height
End With

End Sub

Hi GWteB,
I thank you for your time to reply with my query, i tried the code that u posted unfortunately i encountered an error.

 

[GWteB]

Sorry, this line

Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

should have looked like

Set objPic = Me.Shapes.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

 

[Dorknightz]

Sorry, this line

Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

should have looked like

Set objPic = Me.Shapes.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)[/

 

[Dorknightz]

Sorry, this line

Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

should have looked like

Set objPic = Me.Shapes.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

Hi GWteB,

I again thank you very much for the time, there's no more error code really appreciated your help?.

 

[GWteB]

You are welcome and thanks for letting me know