(VBA) Insert Image into Comment & Reduce Image File Size

JamesAs

New Member
Joined
Mar 12, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
Hi,

hoping someone might be able to help with some VBA.

Using the code below to Insert and Image into a comment, works well however could do with being able to compress the Image File Size to ensure the workbook stays as light as possible.

Thanks in Advance!




VBA Code:
Sub InsertPictureComment()
'PURPOSE: Insert an Image into the ActiveCell's Comment
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim PicturePath As String
Dim CommentBox As Comment

'[OPTION 1] Explicitly Call Out The Image File Path
  'PicturePath = "C:\Users\chris\Desktop\Image1.png"

'[OPTION 2] Pick A File to Add via Dialog (PNG or JPG)
   With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Title = "Select Comment Image"
    .ButtonName = "Insert Image"
    .Filters.Clear
    .Filters.Add "Images", "*.png; *.jpg"
    .Show
   
    'Store Selected File Path
      On Error GoTo UserCancelled
        PicturePath = .SelectedItems(1)
      On Error GoTo 0
    End With

'Clear Any Existing Comment
  Application.ActiveCell.ClearComments

'Create a New Cell Comment
Set CommentBox = Application.ActiveCell.AddComment

'Remove Any Default Comment Text
  CommentBox.Text Text:=""

'Insert The Image and Resize
  CommentBox.Shape.Fill.UserPicture (PicturePath)
  CommentBox.Shape.ScaleHeight 6, msoFalse, msoScaleFromTopLeft
  CommentBox.Shape.ScaleWidth 4.8, msoFalse, msoScaleFromTopLeft

'Ensure Comment is Hidden (Swith to TRUE if you want visible)
  CommentBox.Visible = False

Exit Sub

'ERROR HANDLERS
UserCancelled:

End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Watch MrExcel Video

Forum statistics

Threads
1,122,241
Messages
5,595,021
Members
413,960
Latest member
ikkin

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