Solved

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

Posted on 2013-06-24
5
441 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
ID: 39283087
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
ID: 39289470
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
ID: 39289531
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
ID: 39290558
Math!!

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

Author Closing Comment

by:Conor_Newman
ID: 39303680
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

867 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

17 Experts available now in Live!

Get 1:1 Help Now