Solved

Add a preview of a picture in a comment box in EXcel

Posted on 2013-06-24
5
440 Views
Last Modified: 2013-07-06
Ok, so I have a worksheet that is essentially a register of files, users upload files to a server location using this tool, the workbook keeps a log of the files and provides a hyperlink to them.

When a user uploads an image file I have the code then adding a comment box to that cell, set to hidden, and insert the image as the background of the comment so on hovering their mouse they get a preview of the picture.

.autosize doesn't work of course on the image, so I use code I get from a post by Peter Thornton on Microsoft forums, that places an image control on the sheet, then uses the height and width of that to resize the comment box, before then removing the image from the worksheet before anyone sees it ;-)

This all works great, until someone comes along with a high resolution picture and my preview doesn't even fit on the monitor.....

How do I set the maximum size of Pict1 below (Line 15) while keeping the aspect ratio locked?


If sFileExt = ".jpeg" Or sFileExt = ".jpg" Or sFileExt = ".bmp" Or sFileExt = ".gif" Or sFileExt = ".jpeg" Or sFileExt = ".jpeg" Or sFileExt = ".tiff" Or sFileExt = ".png" Or sFileExt = ".JPG" Or sFileExt = ".BMP" Or sFileExt = ".GIF" Or sFileExt = ".JPEG" Or sFileExt = ".TIFF" Or sFileExt = ".PNG" Then
Range("A" & lRow).Select
Workbooks(DDM).Sheets("WIP").Activate
    ActiveCell.AddComment
    ActiveCell.Comment.Visible = False
    ActiveCell.Comment.Text Text:="Preview:"
    ActiveCell.Comment.Shape.Fill.UserPicture sLink
    ActiveCell.Comment.Shape.ScaleHeight 3#, msoFalse, msoscaleformtopleft
    ActiveCell.Comment.Shape.ScaleWidth 2.4, msoFalse, msoscaleformtopleft

' Insert image control Pic to set Picture height and width
' Then remove the picture, but leave the control so it's dimensions
' can be used to size the image

Set Pict1 = ActiveSheet.Pictures.Insert(sLink)
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
    End With
    With ActiveCell.Comment.Shape
        .Height = Pict1.Height
        .Width = Pict1.Width
    End With


Pict1.Delete
Set Pict1 = Nothing

Else
End If

Open in new window

0
Comment
Question by:Conor_Newman
  • 3
  • 2
5 Comments
 
LVL 5

Accepted Solution

by:
Jason Schlueter earned 250 total points
Comment Utility
Shape.ScaleHeight and ScaleWidth?

http://msdn.microsoft.com/en-us/library/office/ff822186(v=office.14).aspx
http://msdn.microsoft.com/en-us/library/office/ff840427(v=office.14).aspx

How about something like this.  I don't know if it'll even compile (I'm not near Excel right now).

Dim NewWidth as Integer
Dim NewHeight as Integer
Dim MaxWidth as Integer
Dim MaxHeight as Integer

MaxWidth = 640
MaxHeight = 480

If ((Pict1.Width * MaxHeight) / Pict1.Height) <= MaxWidth Then
	NewWidth = (MaxWidth * Pict1.Height) / Pict1.Width
	NewHeight = MaxHeight
Else
	NewWidth = MaxWidth
	NewHeight = (MaxHeight * Pict1.Width) / Pict1.Height
End If

With ActiveCell.Comment.Shape
	.Height = NewHeight
	.Width = NewWidth
End With

Open in new window

0
 
LVL 2

Author Comment

by:Conor_Newman
Comment Utility
ok, it will compile.. the maths are wrong somewhere, as it end up being stretched width wise massively. lol

It works ok if the pictures are landscape, but if their orientation is portrait id stretches them crazy amounts on the width, way past the MaxWidth, ie: This pic in the screenshot has had it's width stretched to 1121
DSC00600.jpg
0
 
LVL 2

Assisted Solution

by:Conor_Newman
Conor_Newman earned 0 total points
Comment Utility
Ok, this is a little cumbersome, but so far seems to be working,
Basically just a simple maths formula, if pict1 height or width is larger than the max allowed, divide both to get 1% of their size, dive that into the max width / height, and which ever is bigger, multiply each 1% value by that value, increasing both values up to that percentage of the whole.  Maintains the aspect ratio and forces it to comply with the max height / width.

Will mark this as resolved later once I've tested further!

If sFileExt = ".jpeg" Or sFileExt = ".jpg" Or sFileExt = ".bmp" Or sFileExt = ".gif" Or sFileExt = ".jpeg" Or sFileExt = ".jpeg" Or sFileExt = ".tiff" Or sFileExt = ".png" Or sFileExt = ".JPG" Or sFileExt = ".BMP" Or sFileExt = ".GIF" Or sFileExt = ".JPEG" Or sFileExt = ".TIFF" Or sFileExt = ".PNG" Then

Dim NewWidth As Integer
Dim NewHeight As Integer
Dim MaxWidth As Integer
Dim MaxHeight As Integer
Dim TempWidth As Integer
Dim TempHeight As Integer



Range("A" & lRow).Select
Workbooks(DDM).Sheets("WIP").Activate
    ActiveCell.AddComment
    ActiveCell.Comment.Visible = False
    ActiveCell.Comment.Text Text:="Preview:"
    ActiveCell.Comment.Shape.Fill.UserPicture sLink

' Insert Pic to set Control Picture height and width
' Then remove the picture, but leave the control so it's dimensions
' can be used to size the image

Set Pict1 = ActiveSheet.Pictures.Insert(sLink)

    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .ReadingOrder = xlContext
        .Orientation = xlHorizontal
    End With
    
    With ActiveCell.Comment.Shape
        '.Height = Pict1.Height
        '.Width = Pict1.Width
    End With
    
    MaxWidth = 640
    MaxHeight = 480

If Pict1.Width > MaxWidth Or Pict1.Height > MaxHeight Then
        NewWidth = (Pict1.Width / 100)
        NewHeight = (Pict1.Height / 100)
        TempWidth = (MaxWidth / NewWidth)
        TempHeight = (MaxHeight / NewHeight)
    If NewWidth > NewHeight Then
        NewWidth = NewWidth * TempWidth
        NewHeight = NewHeight * TempWidth
    Else
        NewWidth = NewWidth * TempHeight
        NewHeight = NewHeight * TempHeight
    End If

Else

NewWidth = Pict1.Width
NewHeight = Pict1.Height

End If


    With ActiveCell.Comment.Shape
        .Height = NewHeight
        .Width = NewWidth
    End With


Pict1.Delete
Set Pict1 = Nothing

Else
End If

Open in new window

0
 
LVL 5

Expert Comment

by:Jason Schlueter
Comment Utility
Math!!

I'm glad you were able to get it working.
0
 
LVL 2

Author Closing Comment

by:Conor_Newman
Comment Utility
JasonSchlueter's solution worked but only if the images were landscaped, if they were portrait orientation it stretched the width wider than the monitor in some cases.

I made a few small edits to his code to base the scaling on a percentage ratio, to maintain the aspect ratio while shrinking the image to fit with the limits set by the MaxWidth and MaxHeight integers.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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,…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

763 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

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now