ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   resizing a picture to fit a single cell HELP (https://www.excelbanter.com/excel-discussion-misc-queries/124599-resizing-picture-fit-single-cell-help.html)

erical

resizing a picture to fit a single cell HELP
 
I'm creating a spreadsheet featuring a large number of pictures. Each picture
must fit into 1 cell, which i have already resized to fit the desired size.
How can I resize the picture to fit into that 1 cell without the picture
looking disformed?
Thanks for any help you can offer.
Erica

Gord Dibben

resizing a picture to fit a single cell HELP
 
Make the cell really large?

Note: pictures do not go into the cell, only float on top.


Gord Dibben MS Excel MVP

On Wed, 3 Jan 2007 20:00:00 -0800, erical
wrote:

I'm creating a spreadsheet featuring a large number of pictures. Each picture
must fit into 1 cell, which i have already resized to fit the desired size.
How can I resize the picture to fit into that 1 cell without the picture
looking disformed?
Thanks for any help you can offer.
Erica



Ken Johnson

resizing a picture to fit a single cell HELP
 
Hi Erica,

Try this macro.
Select the picture then position it so that its top left corner is
inside the cell that you are wanting it to completely fit without
distortion, then run the macro.

Public Sub FitPic()
On Error GoTo NOT_SHAPE
Dim PicWtoHRatio As Single
Dim CellWtoHRatio As Single
With Selection
PicWtoHRatio = .Width / .Height
End With
With Selection.TopLeftCell
CellWtoHRatio = .Width / .RowHeight
End With
Select Case PicWtoHRatio / CellWtoHRatio
Case Is 1
With Selection
.Width = .TopLeftCell.Width
.Height = .Width / PicWtoHRatio
End With
Case Else
With Selection
.Height = .TopLeftCell.RowHeight
.Width = .Height * PicWtoHRatio
End With
End Select
With Selection
.Top = .TopLeftCell.Top
.Left = .TopLeftCell.Left
End With
Exit Sub
NOT_SHAPE:
MsgBox "Select a picture before running this macro."
End Sub

Ken Johnson



All times are GMT +1. The time now is 08:19 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com