VBA Comment formatting

[ed.ayers315]

Hello Forum Users and Safe & Happy Holidays

Below is code I have to insert a comment with a picture selection in the comment.

What I cannot get down is to set the maximum height and maintain the aspect ration for the width. I just don't want the picture distorted.

Also, it would be great if there is code that could center right the picture in the active cell.

Any help is always appreciated!!

[HTML] 
Sub INSERT_COMMENT_PICTURE()
'
' INSERT_COMMENT_PICTURE Macro
 
Dim HasCom
Dim Pict As String
Dim Ans As Integer
 
Set HasCom = ActiveCell.Comment
If Not HasCom Is Nothing Then ActiveCell.Comment.Delete
Set HasCom = Nothing
 
GetPict:
 
Pict = Application.GetOpenFilename(ImgFileFormat)
'Note you can load in, almost any file format
If Pict = "False" Then End
 
Ans = MsgBox("Open : " & Pict, vbYesNo + vbExclamation, "Use this Picture?")
 
If Ans = vbNo Then GoTo GetPict
With ActiveCell
 
.AddComment
.Comment.Visible = False
.Comment.Shape.Fill.Transparency = 0#
.Comment.Shape.Fill.UserPicture Pict
   .Comment.Shape.IncrementLeft -120.25
            .Comment.Shape.IncrementTop -93.75
            .Comment.Shape.LockAspectRatio = msoTrue
            .Comment.Shape.Height = 108#
            ActiveCell.Comment.Visible = True
 ActiveCell.Offset(0, 0).Rows("1:1").EntireRow.Select
    Selection.RowHeight = 175
    
End With
End Sub

[/HTML]

 

[Worf]

Below is code I have to insert a comment with a picture selection in the comment.
What I cannot get down is to set the maximum height and maintain the aspect ratio for the width. I just don't want the picture distorted.
Also, it would be great if there is code that could center right the picture in the active cell.

Hello Ed
What you asked for can be done, but I was wondering if you really need the comment, or are just using it as a placeholder. In this last case, the picture can be placed directly into a cell or range.
So, please confirm if the picture is going into a comment or into a cell.

 

[ed.ayers315]

Hello Worf,

Yes, the picture will be in the comment.

Thanks!

 

[Worf]

Please test the macro below...

Sub INSERT_COMMENT_PICTURE()

Dim HasCom, Pict$, Ans%, p As Object, t#, L#, w#, h#
 
Set HasCom = ActiveCell.Comment
If Not HasCom Is Nothing Then ActiveCell.Comment.Delete
Set HasCom = Nothing
 
GetPict:
Pict = Application.GetOpenFilename
'Note you can load in, almost any file format
If Pict = "False" Then End
 
Ans = MsgBox("Open : " & Pict, vbYesNo + vbExclamation, "Use this Picture?")
 
If Ans = vbNo Then GoTo GetPict
Set p = ActiveSheet.Pictures.Insert(Pict)   'temporary floating picture

With ActiveCell
    t = .Top
    L = .Left
    w = .Offset(0, 1).Left - .Left
    L = L + w / 2 - p.Width / 2
    If L < 1 Then L = 1
    h = .Offset(1, 0).Top - .Top
    t = t + h / 2 - p.Height / 2
    If t < 1 Then t = 1

    .AddComment
    .Comment.Visible = True
    
    With .Comment.Shape
        .Height = p.Height          ' make comment same size as picture
        .Width = p.Width
        .LockAspectRatio = msoTrue
        .Fill.Transparency = 0#
        .Fill.UserPicture picturefile:=Pict
        .Top = t
        .Left = L
    End With
End With
p.Delete
Set p = Nothing
End Sub

 

[ed.ayers315]

Hi Worf,

Thanks for the reply and the code.

I needed to modify it a little to get the comment picture to fit the row height of the active cell.

Thank you and have a Safe and Happy New Year!!!

Sub INSERT_COMMENT_PICTURE()
'
' INSERT_COMMENT_PICTURE Macro
Dim HasCom, Pict$, Ans%, p As Object, t#, L#, w#, h#
 
Set HasCom = ActiveCell.Comment
If Not HasCom Is Nothing Then ActiveCell.Comment.Delete
Set HasCom = Nothing
 
GetPict:
Pict = Application.GetOpenFilename
'Note you can load in, almost any file format
If Pict = "False" Then End
 
Ans = MsgBox("Open : " & Pict, vbYesNo + vbExclamation, "Use this Picture?")
 
If Ans = vbNo Then GoTo GetPict
Set p = ActiveSheet.Pictures.Insert(Pict)   'temporary floating picture
With ActiveCell
    t = .Top
    L = .Left
    w = .Offset(0, 1).Left - .Left
    L = L + w / 2 - p.Width / 2
    If L < 1 Then L = 1
    h = .Offset(1, 0).Top - .Top
    t = t + h / 2 - p.Height / 2
    If t < 1 Then t = 1
    .AddComment
    .Comment.Visible = True
 
        With .Comment.Shape
         .LockAspectRatio = msoTrue
        .Height = ActiveCell.RowHeight - 10        ' make comment size thus picture size just smaller than active row height
        .LockAspectRatio = msoTrue
        .Fill.Transparency = 0#
        .Fill.UserPicture picturefile:=Pict
        .Top = t
        .Left = L
       End With
End With
p.Delete
Set p = Nothing
End Sub

 

[Worf]

You are welcome, thanks for the feedback.

A Happy 2012 for all the Excel community!