I am using the code below to insert a picture to a specific area within the spreadsheet. Works great, but it is linked to the file on my computer. I would like to be able to save the picture in the spreadsheet and email it for others to view.
Sub ChangeImage()
ActiveSheet.Unprotect Password:=""
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.ButtonName = "Submit"
.Title = "Select an image file"
.Filters.Clear
.Filters.Add "JPG", "*.JPG"
.Filters.Add "JPEG File Interchange Format", "*.JPEG"
.Filters.Add "Graphics Interchange Format", "*.GIF"
.Filters.Add "Portable Network Graphics", "*.PNG"
.Filters.Add "Tag Image File Format", "*.TIFF"
.Filters.Add "All Pictures", "*.*"
If .Show = -1 Then
Dim img As Object
Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
'Scale image size
'img.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
'img.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
'Position Image
img.Left = 590
img.Top = 50
'Set image sizes in points (72 point per inch)
img.Width = 250
img.Height = 250
Else
MsgBox ("Cancelled.")
End If
End With
ActiveSheet.Protect Password:=""
End Sub
Sub ChangeImage()
ActiveSheet.Unprotect Password:=""
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.ButtonName = "Submit"
.Title = "Select an image file"
.Filters.Clear
.Filters.Add "JPG", "*.JPG"
.Filters.Add "JPEG File Interchange Format", "*.JPEG"
.Filters.Add "Graphics Interchange Format", "*.GIF"
.Filters.Add "Portable Network Graphics", "*.PNG"
.Filters.Add "Tag Image File Format", "*.TIFF"
.Filters.Add "All Pictures", "*.*"
If .Show = -1 Then
Dim img As Object
Set img = ActiveSheet.Pictures.Insert(.SelectedItems(1))
'Scale image size
'img.ShapeRange.ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
'img.ShapeRange.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
'Position Image
img.Left = 590
img.Top = 50
'Set image sizes in points (72 point per inch)
img.Width = 250
img.Height = 250
Else
MsgBox ("Cancelled.")
End If
End With
ActiveSheet.Protect Password:=""
End Sub