?
Solved

Resizing the comments box to fit the embedded image

Posted on 2011-02-15
10
Medium Priority
?
208 Views
Last Modified: 2012-05-11
Hi all

I have been making a spreadsheet to collect images from a location on the computer and input them as a image in a comments box. Im looking for a way to lock the aspect ratio for the picture within the macro, and have the image be a certain size. This is the code I have been using (which someone on here previous helped me with):

Sub insert_pic_in_comment()
Range("D14").AddComment
    Range("D14").Comment.Visible = True
    Range("D14").Comment.Text Text:="" & Chr(10) & ""
    Range("D14").Comment.Shape.Fill.UserPicture _
        "C:\Patient\FFS.jpg"
    Range("D14").Comment.Shape.Select True
    Selection.ShapeRange.ScaleWidth 5#, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 6#, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.IncrementTop -125#
End Sub

This works fine as long as the image ratio is 4x6, but when someone needs to use a portrait picture, it gets stretched.

Any and all solutions would be fantastic

Cheers

Ian
0
Comment
Question by:Rogit85
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 4
10 Comments
 
LVL 45

Expert Comment

by:patrickab
ID: 34898285
Try:

Sub insert_pic_in_comment()
    Range("D14").AddComment
    Range("D14").Comment.Visible = True
    Range("D14").Comment.Text Text:="" & Chr(10) & ""
    Range("D14").Comment.Shape.Fill.UserPicture _
        "C:\Patient\FFS.jpg"
    Range("D14").Comment.Shape.Select True
    Selection.ShapeRange.Width 'try a number here
    Selection.ShapeRange.Height 'try a number here
End Sub

Patrick
0
 
LVL 45

Expert Comment

by:patrickab
ID: 34898485
This woks on my machine:

Sub insert_pic_in_comment()
    Range("A1").AddComment
    Range("A1").Comment.Visible = True
    Range("A1").Comment.Text Text:="Sunset" & Chr(10) & ""
    Range("A1").Comment.Shape.Fill.UserPicture _
        "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg"
    Range("A1").Comment.Shape.Width = 200 'try a number here
    Range("A1").Comment.Shape.Height = 120 'try a number here
End Sub

Patrick
0
 

Author Comment

by:Rogit85
ID: 34900446
Hi Patrickab

Thank you for the tips!

I need a way for it to adjust depending on the picture used. It needs to automatically change depending if its a portrait or landscape. The people who will be using this spreadsheet have no VB knowledge and the picture's cant be distorted in any way.
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 45

Expert Comment

by:patrickab
ID: 34900540
Try this instead:

Sub insert_pic_in_comment()
    Range("A1").AddComment
    Range("A1").Comment.Visible = True
    Range("A1").Comment.Text Text:="Sunset" & Chr(10) & ""
    Range("A1").Comment.Shape.Fill.UserPicture _
        "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg"
     Range("A1").Comment.Shape.TextFrame.AutoSize = True
End Sub

Patrick
0
 

Author Comment

by:Rogit85
ID: 34901472
That only wraps it to the text inside the comment, and I wont be using text in mine
0
 
LVL 45

Expert Comment

by:patrickab
ID: 34901867
>That only wraps it to the text inside the comment, and I wont be using text in mine

As pictures do not have a predetermined size there is a problem making anything fit an indeterminately sized object. In other words I don't believe you can do what you want.

Patrick
0
 

Author Comment

by:Rogit85
ID: 34904413
Damn

Well thank you very much for your help, its a shame that it cant be done
0
 

Accepted Solution

by:
Rogit85 earned 0 total points
ID: 34906119
Hi Patricklab

I managed to solve this myself in the end, It opens the image in the spreadsheet, measures it, deletes it then adds it back as a comment image :)

Dim rngTarget As Range
Dim lHeight As Long, lWidth As Long

ActiveSheet.Pictures.Insert("C:\Patient\mao.jpg").Select
With Selection
    lHeight = .Height
    lWidth = .Width
    .Delete
End With
Set rngTarget = ActiveSheet.Range("C7")
With rngTarget
    .AddComment
With .Comment.Shape
    .Width = lWidth
    .Height = lHeight
    .IncrementTop -90#
    .Fill.UserPicture ("C:\Patient\mao.jpg")
End With
End With
    Range("C7").Comment.Visible = False
0
 
LVL 24

Expert Comment

by:Tracy
ID: 35225317
This question has been classified as abandoned and is being closed as part of the Cleanup Program. See my comment at the end of the question for more details.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

649 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question