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

New Member
Joined
Oct 1, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
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
 

Attachments

  • Link canno be displayed.jpg
    Link canno be displayed.jpg
    115.2 KB · Views: 9

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,599
Office Version
  1. 2013
Platform
  1. Windows
Hi, Welcome to MrExcel.
See if this works for you ...

Rich (BB code):
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

New Member
Joined
Oct 1, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
Hi, Welcome to MrExcel.
See if this works for you ...

Rich (BB code):
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.
 

Attachments

  • Error1.jpg
    Error1.jpg
    137.4 KB · Views: 7

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
2,599
Office Version
  1. 2013
Platform
  1. Windows
Sorry, this line
VBA Code:
Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

should have looked like
Rich (BB code):
Set objPic = Me.Shapes.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)
 

Dorknightz

New Member
Joined
Oct 1, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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

should have looked like
Rich (BB code):
Set objPic = Me.Shapes.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)[/
Rich (BB code):
 

Dorknightz

New Member
Joined
Oct 1, 2021
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
Sorry, this line
VBA Code:
Set objPic = Me.AddPicture(Filename:=strFileName, LinkToFile:=False, SaveWithDocument:=True, Left:=1, Top:=1, Width:=-1, Height:=-1)

should have looked like
Rich (BB code):
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

Well-known Member
Joined
Sep 10, 2010
Messages
2,599
Office Version
  1. 2013
Platform
  1. Windows
You are welcome and thanks for letting me know (y)
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,571
Messages
5,770,920
Members
425,652
Latest member
Pemby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top