Solved

Add a picture to excel and resize

Posted on 2011-09-12
10
340 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
10 Comments
 
LVL 3

Expert Comment

by:Thomas_Roes
ID: 36525084
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
ID: 36525357
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 42

Accepted Solution

by:
dlmille earned 500 total points
ID: 36527266
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 42

Expert Comment

by:dlmille
ID: 36527273
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
ID: 36527806
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
 
LVL 42

Expert Comment

by:dlmille
ID: 36530547
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
ID: 36814472
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 42

Expert Comment

by:dlmille
ID: 36801285
@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
ID: 36814473
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 42

Expert Comment

by:dlmille
ID: 36815418
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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,…
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.

726 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