Results 1 to 3 of 3
  1. #1
    Star Lounger
    Join Date
    Apr 2002
    Location
    Sydney, New South Wales, Australia
    Posts
    86
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Resize shape to fit inside cell (excel 97)

    Can anyone help me to resize images (shapes) to fit the single cell that they are in.
    The images are currently smaller than the cell
    (but I would like to have code that could handle it if the image was bigger too, maybe something that identified the image in the cell using just it's topleftcell.address)
    there are many images on the sheet to resize
    I would like to keep the proportion of the image, and they come in all different proportions (some short & wide and some tall & skinny)
    but all the cells are a standard proportion

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Resize shape to fit inside cell (excel 97)

    Try this, but make a backup copy of your workbook first!

    Sub AdjustShapes()
    Dim shp As Shape
    Dim rng As Range
    Dim sngCWidth As Single
    Dim sngCHeight As Single
    Dim sngSWidth As Single
    Dim sngSHeight As Single
    For Each shp In ActiveSheet.Shapes
    sngSWidth = shp.Width
    sngSHeight = shp.Height
    Set rng = shp.TopLeftCell
    shp.Left = rng.Left
    shp.Top = rng.Top
    sngCWidth = rng.Width
    sngCHeight = rng.Height
    If sngSWidth / sngSHeight > sngCWidth / sngCHeight Then
    sngSHeight = sngSHeight * sngCWidth / sngSWidth
    sngSWidth = sngCWidth
    Else
    sngSWidth = sngSWidth * sngCHeight / sngSHeight
    sngSHeight = sngCHeight
    End If
    shp.Width = sngSWidth
    shp.Height = sngSHeight
    Next shp
    End Sub

  3. #3
    Star Lounger
    Join Date
    Apr 2002
    Location
    Sydney, New South Wales, Australia
    Posts
    86
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Resize shape to fit inside cell (excel 97)

    That worked brilliantly.
    <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23> <img src=/S/clapping.gif border=0 alt=clapping width=19 height=23>

    I changed the positioning of the top left a little to allow for a small margin around the image
    shp.Left = rng.Left + 2
    shp.Top = rng.Top + 2
    and then decreased the size of the image by twice that amount in the last few lines of your code
    shp.Width = sngSWidth - 4
    shp.Height = sngSHeight - 4

    Thank you very much for the help, I learnt a lot from this.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •