Inserting Picture - how to align

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

tcb - 30 Dec 2007 13:29 GMT

When inserting a picture into a spreadsheet it automatically aligns to
the top and left of the cell that it is inserted into. How can I get
the bottom and right side of a picture to align to a cell's bottom and
right?

Reply to this Message

Dave Peterson - 30 Dec 2007 15:15 GMT

If you're doing it manually, you can hold the alt key down when you click and
drag the "drag handles". The picture will snap to the row and column edges.

But won't this cause a problem for the aspect ratio of the picture--you could
end up with squished or elongated pictures.

> When inserting a picture into a spreadsheet it automatically aligns to
> the top and left of the cell that it is inserted into. How can I get
> the bottom and right side of a picture to align to a cell's bottom and
> right?

Signature

Dave Peterson

Reply to this Message

tcb - 30 Dec 2007 15:26 GMT

I'd like to do it in vba. A spreadsheet is created in vba, an image
is inserted in the top left, top right, bottom left, and bottom right
of a range. I'd like to have them all align accordingly, if possible.

Reply to this Message

Dave Peterson - 30 Dec 2007 15:41 GMT

Option Explicit
Sub testme01()

Dim myPict As Picture
Dim myPictName As String

myPictName = "C:\test.jpg"

With ActiveSheet
With .Range("a1:b9")
Set myPict = .Parent.Pictures.Insert(Filename:=myPictName)
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = .Width
myPict.Height = .Height
myPict.Name = "Pict_" & .Cells(1).Address(0, 0)
End With
End With
End Sub

> I'd like to do it in vba. A spreadsheet is created in vba, an image
> is inserted in the top left, top right, bottom left, and bottom right
> of a range. I'd like to have them all align accordingly, if possible.

Signature

Dave Peterson

Reply to this Message

tcb - 30 Dec 2007 15:56 GMT

What I mean is that four separate images are to be inserted, one in
each corner of the range, and hopefully keep their aspect ratio to
boot! The images would be fairly small, like company logos. Thanks.

Reply to this Message

Ken Johnson - 30 Dec 2007 22:36 GMT

> What I mean is that four separate images are to be inserted, one in
> each corner of the range, and hopefully keep their aspect ratio to
> boot! The images would be fairly small, like company logos. Thanks.

Assuming that the picture sizes aren't an issue this positions 4
shapes named Pic1, Pic2, Pic3 and Pic4 into the corners of a range
named rgFrame...

Option Explicit
Public Sub CornerPix()
Dim rgFrame As Range, _
Pic1 As Shape, _
Pic2 As Shape, _
Pic3 As Shape, _
Pic4 As Shape
With ActiveSheet
Set rgFrame = .Range("rgFrame")
Set Pic1 = .Shapes("Pic1")
Set Pic2 = .Shapes("Pic2")
Set Pic3 = .Shapes("Pic3")
Set Pic4 = .Shapes("Pic4")
End With
With rgFrame
Pic1.Left = .Left
Pic2.Left = .Left + .Width - Pic2.Width
Pic3.Left = .Left
Pic4.Left = .Left + .Width - Pic4.Width
Pic1.Top = .Top
Pic2.Top = .Top
Pic3.Top = .Top + .Height - Pic3.Height
Pic4.Top = .Top + .Height - Pic4.Height
End With
End Sub

Ken Johnson

Reply to this Message

Dave Peterson - 30 Dec 2007 23:07 GMT

Unless you're extremely lucky, I'm not sure how you can have a picture preserve
its aspect ratio and fit the cell exactly.

This routine sizes the picture to the row height of each of the cells.

Option Explicit
Sub testme01()

Dim myPict As Picture
Dim myPictName As Variant
Dim iCtr As Long
Dim myRng As Range
Dim myCell As Range
Dim myPath As String
Dim myRatio As Double

myPath = "C:\My Pictures\testPix"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myPictName = Array("DSC00116.JPG", _
"DSC00117.JPG", _
"DSC00118.JPG", _
"DSC00119.JPG")

With ActiveSheet
Set myRng = .Range("a1:c9")

For iCtr = LBound(myPictName) To UBound(myPictName)
With myRng
Select Case iCtr
Case Is = LBound(myPictName)
Set myCell = myRng.Cells(1)
Case Is = LBound(myPictName) + 1
Set myCell = .Cells(.Row, _
.Columns(.Columns.Count).Column)
Case Is = LBound(myPictName) + 2
Set myCell = .Cells(.Rows(.Rows.Count).Row, .Column)
Case Else
Set myCell = .Cells(.Cells.Count)
End Select
End With

With myCell
Set myPict = .Parent.Pictures.Insert _
(Filename:=myPath & myPictName(iCtr))
myPict.ShapeRange.LockAspectRatio = msoFalse
myRatio = myPict.Width / myPict.Height
myPict.Top = .Top
myPict.Left = .Left
myPict.Height = .Height
myPict.Width = .Height * myRatio
myPict.Name = "Pict_" & .Cells(1).Address(0, 0)
myPict.ShapeRange.LockAspectRatio = msoTrue
End With
Next iCtr
End With
End Sub

Signature

Dave Peterson

Reply to this Message

Rate this thread: