Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

How to insert 3 images into excel with aligning each positions?

10 views
Skip to first unread message

Eric

unread,
Feb 10, 2010, 1:49:01 AM2/10/10
to
Does anyone have any suggestions on how to insert 3 images into excel with
aligning each positions? Please see following code for detailed description.
Does anyone have any suggestions?
Thanks in advance for any suggestions
Eric


Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPic 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 myPic = ActiveSheet.Pictures(1)
On Error GoTo 0
If Not myPic Is Nothing Then myPic.Delete

If Range("A1") = 1 Then
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic.JPG")
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic3.JPG")
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic5.JPG")
' I try to insert more code here, but it does not work
Else
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic2.JPG")
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic4.JPG")
Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic6.JPG")
End If

dblTop = Cells(10, "B").Top
dblLeft = Cells(10, "B").Left
dblHeight = Cells(14, "B").Top - Cells(10, "B").Top
dblWidth = Cells(10, "D").Left - Cells(10, "B").Left

'Furthermore, I get no idea on how to align 3 different images from
following code.
With myPic
.ShapeRange.LockAspectRatio = msoFalse '/ msoTrue
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With

End If

End Sub

OssieMac

unread,
Feb 10, 2010, 3:36:01 AM2/10/10
to
Hi again Eric,

You could have continued the tread you started before.

Tell us where you want each of the pictures. The first one you previously
gave me as B10 to C13 inclusive for position and size. What position and size
do you want each of these additional ones?

--
Regards,

OssieMac

Jacob Skaria

unread,
Feb 10, 2010, 3:37:01 AM2/10/10
to
Try one by one as below....


'Get the locations


dblTop = Cells(10, "B").Top
dblLeft = Cells(10, "B").Left
dblHeight = Cells(14, "B").Top - Cells(10, "B").Top
dblWidth = Cells(10, "D").Left - Cells(10, "B").Left

'Insert picture


Set myPic = ActiveSheet.Pictures.Insert("C:\TempPic.JPG")

'Set location


With myPic
.ShapeRange.LockAspectRatio = msoFalse '/ msoTrue
.Top = dblTop
.Left = dblLeft
.Height = dblHeight
.Width = dblWidth
End With

--
Jacob

Eric

unread,
Feb 10, 2010, 4:14:01 AM2/10/10
to
Thank everyone very much for suggestions
I would like to know the (1) within .Pictures, does 1 represent 1 image to
be selected and deleted? If I have 3 images, then do I need to set (3) with
.Pictures to perform the Delete function?
Thank everyone very much for any suggestions
Eric

Set myPic = ActiveSheet.Pictures(1)
On Error GoTo 0
If Not myPic Is Nothing Then myPic.Delete

OssieMac

unread,
Feb 10, 2010, 6:21:02 AM2/10/10
to
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


Eric

unread,
Feb 10, 2010, 9:11:02 AM2/10/10
to
Thank everyone very very much for suggestions
Eric

Eric

unread,
Feb 11, 2010, 3:46:01 AM2/11/10
to
Does anyone have any suggestions on how to solve the triggering issue?
The value within cell A1 is calculated by formula, so I don't need to
manually press enter everytime to update this value, the question is the rest
of coding will not be performed without triggering cell A1, so does anyone
have any suggestions on how to trigger the rest of coding without manually
update the A1 cell's value?

Thank everyone very much for any suggestions
Eric

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

Roger Govier

unread,
Feb 11, 2010, 4:10:04 AM2/11/10
to
hi Eric

perhaps you could make the formula in A1 volatile by adding and subtracting
NOW()

=your_formula+NOW()-NOW()

--
-------
Regards
Roger Govier

"Eric" <Er...@discussions.microsoft.com> wrote in message
news:EA038C47-AD84-464A...@microsoft.com...

> __________ Information from ESET Smart Security, version of virus
> signature database 4856 (20100210) __________
>
> The message was checked by ESET Smart Security.
>
> http://www.eset.com
>
>
>

__________ Information from ESET Smart Security, version of virus signature database 4856 (20100210) __________

The message was checked by ESET Smart Security.

http://www.eset.com

Eric

unread,
Feb 11, 2010, 7:16:01 AM2/11/10
to
I have tried it, but it does not work, do you have any more suggestions?

Thank everyone very much for any suggestions
Eric

"Roger Govier" wrote:

> .
>

0 new messages