View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Eric Eric is offline
external usenet poster
 
Posts: 1,670
Default How to insert 3 images into excel with aligning each positions

Thank everyone very very much for suggestions
Eric

"OssieMac" wrote:

Hi again Eric,

I still don't know exactly how you want the pictures aligned (Horizontally
or vertically). The following code aligns them horizontally with one cell in
between. I have Used Range("B10") style addressing instead of Cells. Perhaps
you can understand that better.

All of the alignment and sizing is based on the Top and Left position of
cells.

I have created names for the shapes so they relate to the top left cell of
each picture. The pictures must be named at the time of inserting so that
they can be referred to again like when deleting. You cannot simply use the
Picture index like Picture(1) because that refers to the first picture on the
sheet irrespective of what it is. If you delete Picture(1) then what was
Picture(2) becomes Picture(1). Once named the name does not change and can be
used to reference the picture.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPic1 As Object
Dim myPic2 As Object
Dim myPic3 As Object
Dim dblTop As Double
Dim dblLeft As Double
Dim dblHeight As Double
Dim dblWidth As Double

If Target.Address = "$A$1" Then
On Error Resume Next
Set myPic1 = ActiveSheet.Pictures("PicAtB10")
Set myPic2 = ActiveSheet.Pictures("PicAtE10")
Set myPic3 = ActiveSheet.Pictures("PicAtH10")
On Error GoTo 0
If Not myPic1 Is Nothing Then myPic1.Delete
If Not myPic2 Is Nothing Then myPic2.Delete
If Not myPic3 Is Nothing Then myPic3.Delete

If Range("A1") = 1 Then
Set myPic1 = ActiveSheet.Pictures.Insert("C:\TempPic1.JPG")
Set myPic2 = ActiveSheet.Pictures.Insert("C:\TempPic3.JPG")
Set myPic3 = ActiveSheet.Pictures.Insert("C:\TempPic5.JPG")
Else
Set myPic1 = ActiveSheet.Pictures.Insert("C:\TempPic2.JPG")
Set myPic2 = ActiveSheet.Pictures.Insert("C:\TempPic4.JPG")
Set myPic3 = ActiveSheet.Pictures.Insert("C:\TempPic6.JPG")
End If

'Name and align myPic1 (Cells B10 to C13)

myPic1.Name = "PicAtB10"

dblTop = Range("B10").Top
dblLeft = Range("B10").Left
dblHeight = Range("B14").Top - Range("B10").Top
dblWidth = Range("D10").Left - Range("B10").Left

With myPic1
.ShapeRange.LockAspectRatio = msoFalse
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With

'Name and align myPic2 (Cells E10 to F13)

myPic2.Name = "PicAtE10"

dblTop = Range("E10").Top
dblLeft = Range("E10").Left
dblHeight = Range("E14").Top - Range("E10").Top
dblWidth = Range("G10").Left - Range("E10").Left

With myPic2
.ShapeRange.LockAspectRatio = msoFalse
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With

'Name and align myPic3 (Cells H3 to I13)

myPic3.Name = "PicAtH10"

dblTop = Range("H10").Top
dblLeft = Range("H10").Left
dblHeight = Range("H14").Top - Range("H10").Top
dblWidth = Range("J10").Left - Range("H10").Left

With myPic3
.ShapeRange.LockAspectRatio = msoFalse
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With

End If

End Sub

--
Regards,

OssieMac