resize picture to cell size

Kade

Active Member
Joined
Jul 20, 2002
Messages
258
hi all,

I have searched for ages and can find plenty of references to resize a cell to a picture....... but I want a picture to resize to the cells size.

I do not want to use a cell note
the size of the cells have been set at ht 225 width 58

i understand that what I want may distort the image but thats ok for my need

thanks to the board I currently use this, which is great , but only if the images imported are the same size

Sub InsertPicture()

Dim myPicture As String

myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If myPicture <> "" Then
ActiveSheet.Pictures.Insert (myPicture)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select
Selection.ShapeRange.ScaleWidth 0.64, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.64, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.97, msoFalse, msoScaleFromTopLeft

End If
End Sub

I presume it is the last three lines I need to rejig.

tia kd
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Hello, try adapting the following:

<font face=Courier New>myPic <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Set</SPAN> myPic = ws.Pictures.Insert(MyDir & Nme)
<SPAN style="color:darkblue">With</SPAN> myPic
    .Top = ws.[a1].Top
    .Left = ws.[a1].Left
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = ws.[a1].RowHeight
    .ShapeRange.Width = ws.[a1].Width
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">With</SPAN>
<SPAN style="color:darkblue">Set</SPAN> myPic = <SPAN style="color:darkblue">Nothing</SPAN></FONT>

Hope this helps.

Edit: pulled a comment that didn't make sense.
 
Upvote 0
thanks Nate

Am i seeing things or did u edit your post? :-?

this has helped a lot but I when I run it, it doesn't fill to the width (height and top left fine). Can u see any probs in what I have

btw it seems to be about a ratio of 5.5 to 6 times filling entire width, but is not consistant

tia kd


With Selection
.ShapeRange.LockAspectRatio = msoFalse
.Top = ActiveCell.Top

.Left = ActiveCell.Left

.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.ColumnWidth

End With
 
Upvote 0
Hi all

with a little help from my friends and trial and error this does what I want.

Imports selected picture, and resizes the picture to what ever the cell size is.

Can anyone explain why I need to multiply by 5.25 and add 4 to make it fit width wise (it appears to work for any cell width I try)
.ShapeRange.Width = ActiveCell.ColumnWidth * 5.25 + 4

Is it something to do with the units of cell width????, or do I just accept that it works :-?


Sub InsertPicture()

Dim myPicture As String

myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "Select Picture to Import")
If myPicture <> "" Then
ActiveSheet.Pictures.Insert (myPicture)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Select

With Selection

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = ActiveCell.RowHeight
.ShapeRange.Width = ActiveCell.ColumnWidth * 5.25 + 4
.Placement = xlMoveAndSize


End With
End If
End Sub
 
Upvote 0
Hello, I did modify my post.

Instead of using columnwidth, use width like I did, this will return the number you want.

Oh no need to select the object, just set it on the insert and work with it from there.
 
Upvote 0
Thanks Nate, I should have read your answer more carefully , I have been trying to do that for ages it is a great assistance to me for doing reports.

kd
 
Upvote 0

Forum statistics

Threads
1,223,098
Messages
6,170,100
Members
452,301
Latest member
QualityAssurance

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top