Resizing a picture in excel using VBA

[Derby2007]

Hello,

As the title goes this is as simple as it gets. The macro worked good when I was using excel 2003 but now that I have 2007 everything works for except the resizing (Picture.Width & Picture. Height).

Sub AddImage()
Dim strPath As String
Dim strFile As String
Dim Picture As Object
Dim Response As String
Dim C As Range
strPath = "C:\\Photos\"
 
For Each C In Range("A1", Range("A65536").End(xlUp))
    If C <> 0 Then
        With C.Offset(0, 1)
            Set Picture = Nothing
            On Error Resume Next
            Set Picture = Sheets("Raw Pix").Pictures.Insert(strPath & C.Value & ".jpg")
            Picture.Top = .Top
            Picture.Left = .Left
            Picture.LockAspectRatio = msoTrue
[B]            Picture.Width = 157
            Picture.Height = 138[/B]

        
    End With
    End If
     
NextC:
Next C
End Sub

I have tried to record some macros while I am resizing the pictures but to no avail the macros are blank.

Please help

Thanks!

 

[dscg]

Try changing these lines:

            Picture.ShapeRange.LockAspectRatio = msoTrue
            Picture.ShapeRange.Width = 157
            'Picture.ShapeRange.Height = 138

Note that since you're locking the aspect ratio, you only need to specify just the width or the height.

HTH!

 

[Derby2007]

I am sorry I do not want to lock the apect ratio.

Does anybody know what the VBA code for "Relative to original picture size" AND "Move and size with cells"

Thanks!!!

 

[dscg]

In that case, try:

            Picture.ShapeRange.LockAspectRatio = msoFalse
            Picture.Placement = xlMoveAndSize
            Picture.ShapeRange.Width = 0.5 * Picture.Width
            Picture.ShapeRange.Height = 0.75 * Picture.Height

And adjust percentages as needed.

 

[Derby2007]

SWEEEET!!!!

I had been tinkering with your code and made some adjustments but this worked..

Picture.Top = .Top
            Picture.Left = .Left
            Picture.ShapeRange.LockAspectRatio = msoFalse
            Picture.Placement = xlMoveAndSize
            Picture.ShapeRange.Width = 157
            Picture.ShapeRange.Height = 138

Thank you, DSCG, very much for your help!!!!

 

[Derby2007]

I that I had but I really don't.

It seems that the width is works fine but what makes that the height continue to change? I even tried to size some photos to the same size but it seems by the time it gets to the last row its not even with the same row it should be.

Any picture wizards out there?

Thanks in advance!

 

[Akanjana]

I that I had but I really don't.

It seems that the width is works fine but what makes that the height continue to change? I even tried to size some photos to the same size but it seems by the time it gets to the last row its not even with the same row it should be.

Any picture wizards out there?

Thanks in advance!

Even i am looking for the same answer. as picture size get changed after paste special.