Inserting Picture - how to align

  • Thread starter Thread starter tcb
  • Start date Start date
T

tcb

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?
 
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.
 
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.
 
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
 
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.
 
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.
Click to expand...

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
 
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
 
Back
Top