Get a reference to the last object pasted

G

Guest

I am using the following code line to paste an image from the clipboard into
the current Excel sheet:

ActiveSheet.PasteSpecial(Format:="Picture (Enhanced Metafile)", Link:=False,
DisplayAsIcon:=False)

How can I modify this so that I can return a reference to the object just
pasted, or after posting, how can I return a reference?

Thanks much...
 
S

Sharad Naik

See my reply to your earlier post.
I gave example referring to the earlier pasted pix.

Sharad
 
G

Guest

Thanks so much Sharad. I didn't see your earlier post before posting this one.

One more question: some of my graphics overlay vertical page breaks and
therefore an image may appear broken over two pages. Do you, by any chance,
have a function that can correct for this? I know this is a tough one...

Thanks again in any case!
 
S

Sharad Naik

After the Top + Height line
add following

DoEvents
IF shpSh1.Width > 432 Then
shpSh1.Width = 432
End If
DoEvents

Note: DoEvents above is by experience. If by anymeans excel is displaying
default
pagebreaks (either through code if HPageBreaks or VPageBreaks protperty
is used or user goes in to PageBreak View) Excel somehow changes its
scale of Points. .Height=1 in normal case may aactually become 3 points.
DoEvents solves this problem.

Sharad
 
S

Sharad Naik

Well the earlier code, will distort the pircture.
What you can do is:
Ir shpSh1.Width > 432 Then
Dim sWd
sWd = shpSh1.Width
shpSh1.Width = 432
shpSh1.Height = Fix(shpSh1.Height * 432 / sWd)
End If

Above is assuming that the page orientation is Portrait.
If it is LandScape, replace 432 by 672.

Sharad
 
G

Guest

Thanks again Sharad!

Please don't think I am taking advantage of a great thing here, but is there
a solution for horizontal page breaks also? Most of my graphics are
vertically arranged, and many of them overlay the horizontal breaks as well.

Any ideas on this?
 
S

Sharad Naik

Here you go, for Protrait Page:

SubCopyPix()
Dim shp As Shape, shpSh1 As Shape
Dim i, j
Dim wdBeTop As Long, wdBeBtm As Long
Sheet1.Select
Sheet1.Range("A1").Select
j = 1
For Each shp In Sheet2.Shapes
shp.CopyPicture
Sheet1.Paste
i = Sheet1.Shapes.Count
Set shpSh1 = Sheet1.Shapes(i)
'Below If para :- In case a single
'pictrue height is more than a page
If shpSh1.Height > 714 Then
DoEvents
shpSh1.Width = shpSh1.Width * 714 / shpSh1.Height
shpSh1.Height = 714
DoEvents
End If

If i > 1 Then
DoEvents
shpSh1.Left = Sheet1.Shapes(i - 1).Left
wdBeTop = Sheet1.Shapes(i - 1).Top _
+ Sheet1.Shapes(i - 1).Height
wdBeBtm = wdBeTop + shpSh1.Height
If wdBeBtm > j * 714 Then
wdBeTop = j * 714
j = j + 1
End If
shpSh1.Top = wdBeTop
If shpSh1.Width > 432 Then
DoEvents
Dim sWd
sWd = shpSh1.Width
shpSh1.Width = 432
shpSh1.Height = Fix(shpSh1.Height * 432 / sWd)
DoEvents
End If
DoEvents
End If
Next
End Sub

For LandScape page:
Replace 714 by 459 AND
Replace 432 by 672.

Hope that helps

Sharad
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top