Excel -Insert picture in comment box macro 1

[renigar]

I thought somebody might find this useful. I was trying to put pictures into comment boxes and browsing various code to do this and everyone seemed to be having trouble with locking the aspect ratio. So I grabbed small pieces of code and added a little to it and came up with this. It will call up the file dialog, you select your picture, and then the selected picture is inserted into a comment box on the currently selected cell. The macro prompts for a scaling factor that divides each pixel dimension (H, W) by the number entered in the input box and preserves the aspect ratio. The larger the number input the smaller the picture in the comment box. Thanks to those who contributed code to this. If anyone wants to improve on it be my guest. My knowledge of VBA could always use some improving.

Sub InsertPhotoInComment()
'   Created in Excel 2010/Win 7, also tested in Excel 2003/Vista.
'   Macro allows user to put a picture in a comment box and
'   specify scaled display size. Note: pictures that have a large
'   file size will dramatically increase workbook file size.

'   Create variables
Dim Finfo As String         ' Used for file extension filters
Dim FilterIndex As Integer  ' Used to indicate default file extension
Dim Title As String         ' Used to hold the file dialog title text
Dim FileName As Variant     ' Holds the file name that is selected
Dim commentBox As Comment   ' Holds the comment box
Dim H As Long               ' Holds the height value of the selected picture
Dim W As Long               ' Holds the width value of the selected picture
Dim RF As Variant           ' Holds the picture reduction factor from inputbox

'   Allows the user to use the File Open dialog to select a file.
'   Set up list of file extension filters for the file type drop down,
'   I used wild card only. Others could be added.
Finfo = "All Files (*.*),*.*"
'   Display All Files by default. If you have more extensions in the above list
'   the FilterIndex determines what number in the list shows by default.
FilterIndex = 1
'   Set the dialog box title caption
Title = "Select a Picture File to Insert into Comment Box"
'   Get the filename
FileName = Application.GetOpenFileName(Finfo, _
FilterIndex, Title)
'   Handle return info from dialog box
If FileName = False Then
    MsgBox "No file was selected."
End If
'   Exit macro if no file is selected
If FileName = False Then Exit Sub

'   Get relative dimensions of the picture chosen.
'   I chose a 599 W x 800 H picture and got 15849 x 21167.
'   I have no idea what units these numbers represent, but they
'   are 26.459 (rounded off) X each pixel dimension.
Set myImg = LoadPicture(FileName)
H = myImg.Height
W = myImg.Width

'   Prompt user for scaling reduction factor
RF = InputBox(Prompt:="What reduction factor do you want to apply to the picture?" & _
    vbNewLine & "Height and Width will be divided by the number input." & vbNewLine _
     & "Input a number greater than zero!", Title:="Picture Scaling Reduction Factor")

'   Warning message if not number greater than zero and exit macro
If Not IsNumeric(RF) Or RF = 0 Then MsgBox "Entered value must be a number greater than zero"
If Not IsNumeric(RF) Or RF = 0 Then Exit Sub
  
' Any existing comments must be cleared before adding a new one.
ActiveCell.ClearComments

Set commentBox = ActiveCell.AddComment

'   Put picture into comment and set attributes
With commentBox
    .Text Text:=""
    With .Shape
       .Fill.UserPicture (FileName)
       .Width = (W / 26.459) / RF    ' The first part of equation scales picture to native size
       .Height = (H / 26.459) / RF   ' the second part scales the picture by the reduction factor.
    End With
    .Visible = False
End With

End Sub

 

[renigar]

Disregard above code. I left out something and want to improve something. I didn't see a way to edit previous post.

Sub InsertPhotoInComment3()
'   Created in Excel 2010/Win 7, also tested in Excel 2003/Vista.
'   Macro allows user to put a picture in a comment box and
'   specify scaled  % display size. Note: pictures that have a large
'   file size will dramatically increase workbook file size.

'   Create variables
Dim Finfo As String         ' Used for file extension filters
Dim FilterIndex As Integer  ' Used to indicate default file extension
Dim Title As String         ' Used to hold the file dialog title text
Dim FileName As Variant     ' Holds the file name that is selected
Dim commentBox As Comment   ' Holds the comment box
Dim myImg As Variant        ' Holds the picture, for find dimensions
Dim ZF As Integer           ' Holds the picture zoom factor from inputbox

'   Allows the user to use the File Open dialog to select a file.
'   Set up list of file extension filters for the file type drop down,
'   I used wild card only. Others could be added.
Finfo = "All Files (*.*),*.*"
'   Display All Files by default. If you have more extensions in the above list
'   the FilterIndex determines what number in the list shows by default.
FilterIndex = 1
'   Set the dialog box title caption
Title = "Select a Picture File to Insert into Comment Box"
'   Get the filename
FileName = Application.GetOpenFileName(Finfo, _
FilterIndex, Title)
'   Handle return info from dialog box
If FileName = False Then
    MsgBox "No file was selected."
End If
'   Exit macro if no file is selected
If FileName = False Then Exit Sub

Set myImg = LoadPicture(FileName)

'   Prompt user for scaling zoom % factor
On Error Resume Next
ZF = InputBox(Prompt:="Input zoom % factor to apply to picture?" & _
    vbNewLine & "Original picture size equals 100." & vbNewLine _
     & "Input a number greater than zero!", Title:="Picture Scaling Reduction Factor")
If ZF = "" Then Exit Sub
'   Warning message if not number greater than zero and exit macro
If Not IsNumeric(ZF) Or ZF = 0 Then MsgBox "Entered value must be a number greater than zero"
If Not IsNumeric(ZF) Or ZF = 0 Then Exit Sub
  
' Any existing comments must be cleared before adding a new one.
ActiveCell.ClearComments

Set commentBox = ActiveCell.AddComment

'   Put picture into comment, set attributes and scale display size
With commentBox
    .Text Text:=""
    With .Shape
       .Fill.UserPicture (FileName)
       .Width = myImg.Width * ZF / 2645.9
       .Height = myImg.Height * ZF / 2645.9
    End With
    .Visible = False
End With

End Sub

 

[renigar]

I tested the second set of code on Excel 2007/Win Xp and it did not like the line Dim ZF As Integer. I changed it to Dim ZF As Variant and it seems to work fine.

 

[SkipVought]

renigar,

Very nice. You ought to post this code in a FAQ.

I modified your code to automatically calculate the scaling factor as the max of either W / cmt.Shape.Width or H / cmt.Shape.Height.

I also FIND an existing comment box that corresponds to the ActiveCell containing the comment box...

dim cmt as comment

for each cmt in activesheet.comments
  with cmt
    if not intersect(.parent, activecell) is nothing then
      'houston, we have the comment! now size & insert the picture

    end
  end with
next

I never knew that an IMAGE could be inserted into a comment. Nice job. Have a [purple]Little Purple Star[/purple]!

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[renigar]

Thanks Skip,

I looked at putting it in FAQ but I'm feeling a little dense and couldn't figure out how to do that. I'm sure it is easy. Could you give me some direction. Also is there a general help page on the site?

renigar

 

[SkipVought]

FAQs are related to each forum, so in THIS forum, not in this Thread, just click the FAQ button located near the top of that forum's page.

Then posting your new FAQ will be similar to posting a new thread, except there are topical categories that your FAQ might logically belong in. So spend some time browsing the FAQ structure.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}