Solved

Add a picture to excel and resize

Posted on 2011-09-12
10
301 Views
Last Modified: 2012-05-12
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
Comment
Question by:kwatt562
  • 5
  • 4
10 Comments
 
LVL 3

Expert Comment

by:Thomas_Roes
Comment Utility
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
 

Author Comment

by:kwatt562
Comment Utility
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
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
Comment Utility
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
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
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
 

Author Comment

by:kwatt562
Comment Utility
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 41

Expert Comment

by:dlmille
Comment Utility
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
 

Author Comment

by:kwatt562
Comment Utility
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
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
@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
 

Author Comment

by:kwatt562
Comment Utility
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
 
LVL 41

Expert Comment

by:dlmille
Comment Utility
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

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now