• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 372
  • Last Modified:

Add a picture to excel and resize

Hi
I'm trying to add a picture to an excel 2007 worksheet via vba. Im using the below code to add the image to N1 but I dont know how to tweak the width and length of the image, Recording a macro in 2007 Excel just appears blank when I try to move the picture.
sub Addpicture ()
With ActiveSheet.Pictures.Insert(“D:\Logos\Log.jpg”)
.Left = ActiveSheet.Range(“N1¿).Left
.Top = ActiveSheet.Range(“N1¿).Top
End With
0
kwatt562
Asked:
kwatt562
  • 5
  • 4
1 Solution
 
Thomas_RoesCommented:
What about this macro:

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B3").Select
    ActiveSheet.Pictures.Insert("D:\Data\test.JPG").Select
    Selection.ShapeRange.ScaleHeight 1.75, msoTrue, msoScaleFromTopLeft
End Sub
0
 
kwatt562Author Commented:
Thanks for your comment
But it doesnt work in the way that I need it too
Now it scales the picture but its in the wrong position
Also I would prefer not to scale the image as I actually want to stretch the image.
0
 
dlmilleCommented:
Put this in a public module.  It imports the Google logo, unlocks the aspect ratio locked setting (so then height and width can be stretched independently of each other).

Code:

 
Sub addPictures()
Dim sht As Worksheet

    Set sht = ActiveSheet
    With sht.Pictures.Insert("http://www.google.co.uk/intl/en_uk/images/logo.gif")
        .Left = sht.Range("N1").Left
        .Top = sht.Range("N1").Top
    End With
    
    'now squish to twice the width, and stretch to 1/8th the height
    With sht.Pictures(1)
        .ShapeRange.LockAspectRatio = msoFalse 'allow stretching
        .Width = .Width * 8
        .Height = .Height / 2
    End With
    

End Sub

Open in new window


See attached, original picture imported, then stretched.  The result anchors the top left picture at the top/left of Range N1.  

PS - by right-clicking a picture and checking properties, you have many clues as to what you can programmatically do with pictures (also some things that may not be available on the dialogue)...You may also want to change your picture properties to move/size your picture with cells, so check those options by selecting the picture and right-clicking to see size/properties.  Of course, there's VBA code for this, as well.

You should be able to customize what you need from here.

Enjoy!

Dave
pictureStretchGoogle-r1.xlsm
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
dlmilleCommented:
To be clear, you can (as you started with your code) make all the property changes to the picture in the same WITH...

 
Sub addPictures()
Dim sht As Worksheet

    Set sht = ActiveSheet
    With sht.Pictures.Insert("http://www.google.co.uk/intl/en_uk/images/logo.gif")
        .Left = sht.Range("N1").Left
        .Top = sht.Range("N1").Top
    
        'now squish to twice the width, and stretch to 1/8th the height
        .ShapeRange.LockAspectRatio = msoFalse 'allow stretching
        .Width = .Width * 8
        .Height = .Height / 2
    End With
    

End Sub

Open in new window


See attached.

Cheers,

Dave
pictureStretchGoogle-r1.xlsm
0
 
kwatt562Author Commented:
Thanks for all your comments, I managed to get it to work last night with
Sub InsertPicture()

    ActiveSheet.Pictures.Insert("D:\Documents and Settings\hyd0415\My Documents\My Pictures\Logos\image.JPG").Select
Dim oPic As Shape, allpic As String
 Dim oP As String, ac As Integer, c, t
 ActiveSheet.Pictures.Visible = True
  c = 700
  t = 10
  For Each oPic In ActiveSheet.Shapes
   If oPic.Type = 13 Then
        With oPic            
             .Width = 300
            .Height = 65
            .Top = t
            .Left = c
             c = c + 70
             If c >= 560 Then t = t + 70
             c = IIf(c >= 560, 10, c)
    .ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
    End With
         End If
             
     Next oPic
End Sub
0
 
dlmilleCommented:
kwatt562 - if the aspect ratio is not locked in your picture, that might work.  However, if you try it with the picture link I put in my post, you'll see that it doesn't work - I tried this, myself, just now - so, just advising you.  

Again, that's because you need to change the lockAspectRatio property of the picture, before trying to change height/width.

Did you try my post with your picture?

Dave
0
 
kwatt562Author Commented:
I've requested that this question be closed as follows:

Accepted answer: 0 points for kwatt562's comment http:/Q_27304003.html#36527806

for the following reason:

This is a solution to my problem
0
 
dlmilleCommented:
@kwatt562 - did you try the solution I proposed.  From where I sit, it met the expectations of your question.

Thanks for your considered response.  You had specifically identified that scaling would not work, which is why I did research and developed the proposed solution.  Given the effort of E-E experts in providing a solution, it would be appreciated getting feedback.  Did you try the solution and did it work for you?

Cheers,

Dave
0
 
kwatt562Author Commented:
Hi
Your solution did work but I had already implemented my own solution before the post. But you are right I should award you the points for your great assistance, thanks
0
 
dlmilleCommented:
thanks for the feedback - the main reason I asked (I wasn't going to object) is to ensure I was doing "my job" in providing a response that would work, and to learn as a result if my proposed solution did not work.  The points, however, are also appreciated :)

Dave
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now