How to copy a drawing image between sheets

[Guest]

Hi all

while copying data, I want to copy images between sheets. How can I do it?


Clara

thank you so much for your help

 

[Peter T]

Hi Clara,

It's not clear if you want to copy individual pictures or all pictures from
one sheet to another. Here's a pair of macros to do both -

Sub CopyAllPictures()
Dim r As Long, c As Long
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim pic As Picture

Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

r = wsSource.Rows.Count
c = wsSource.Columns.Count

For Each pic In wsSource.Pictures
With pic.TopLeftCell
If .Row < r Then r = .Row
If .Column < c Then c = .Column
End With
Next

wsDest.Activate
wsDest.Cells(r, c).Activate

wsSource.Pictures.Copy
wsDest.Paste

wsDest.Cells(r, c).Activate

End Sub

Sub CopyOnePicture()
Dim wsSource As Worksheet
Dim wsDest As Worksheet

Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

Set pic = wsSource.Pictures("Picture 1")

pic.Copy
wsDest.Paste

With wsDest.Pictures(wsDest.Pictures.Count)
.Left = pic.Left
.Top = pic.Top
End With

End Sub

Regards,
Peter T

 

[Guest]

Hi Peter,

Thanks for your code, unfortunately, I am using Excel 2000 and I can not
find Pictures property of object Worksheet.

Clara

 

[Peter T]

Picture and Pictures is a 'hidden' object and collection at the
DrawingObject level, should work fine in xl2000.

Type don't paste -
Dim pic as picture
After pressing Enter picture will revert to Picture

In a panel object browser F2 right click and select 'Show Hidden Members'

Did you try the macros.

Regards,
Peter T

 

[Guest]

Hi Peter,

Your code works very well. But I still have two questions to ask:

1.why do you not use the DrawingObject bridge the Worksheet object and
Pictures collection
2.How can I chage the picure objec in Design Mode, I mean I can view the
property of the object like a button or a worksheet.

Thank you very much

Clara

 

[Peter T]

1. If you only want to copy the one Picture you could equally use
DrawingObject or Picture object types, no difference assuming of course you
want to deal with a Picture. If you are doing something with multiple
Pictures I find it much easier to use the Pictures collection. It kind of
acts like a filter to the DrawingObjects to return only Pictures. In the
example what could be easier than -

wsSource.Pictures.Copy

vs - all the following to do same thing -

Dim shp As Shape
Dim i As Long

if wsSource.shapes.count = 0 then exit sub
ReDim arr(1 To wsSource.Shapes.Count)

For Each shp In wsSource.Shapes
If shp.Type = msoPicture Then
i = i + 1
arr(i) = shp.DrawingObject.ZOrder
End If
Next
if i then
ReDim Preserve arr(1 To i)
wsSource.DrawingObjects(arr).Copy
else
' no pictures
end if

2. I don't quite follow what you are asking. If you declare pic as Picture,
then type pic. you should see the intellisence as soon as you type the dot.

Set pic = ActiveSheet.Pictures(1)
pic.Duplicate
With pic
..Left = .Left + .Width
End With

You mentioned buttons, similarly Button and Buttons are hidden subset of the
DrawingObjects collection
Dim but as Button
for each but in Activesheet.Buttons
debug.? but.caption

Regards,
Peter T

 

[Guest]

Hi Peter,

I have a Maple logon on left top of my sheet and I would like to find a way
to assign a name ,"Maple" ,to it , so in my code I can use string "Maple" as
a reference to it.
so I no longer have to user "Picture 1" The real problem is when I insert
the picture, Excel doesn't provide a way to access the picture's property
dialgoue like the form controls do, so I want to ask is it possible to assing
the picture's name in so called desing mode?

Thank you for your answer to my first question.

Clara

 

[Peter T]

Hi again,

If I follow, you want to change the name of the object named "Picture 1" to
"Maple".

Any of these should work

ws.Shapes("Picture 1").name = "Maple"
ws.DrawingObjects("Picture 1").name = "Maple"
ws.Pictures("Picture 1").name = "Maple"

If you're not sure of the name eg just inserted or copied a picture with
code -

ws.Shapes(ws.Shapes.Count).Name = "Maple"
(or use DrawingObjects or Pictures)

If you copy the object named "Maple" to another sheet that already has a
similarly named object, contrary to what one might expect the copied
object's name is not changed to say "Maple(1)". IOW you could end up with
two similarly named objects on the sheet, something to what out with
ambiguity trying to reference the named object in future.

Excel doesn't provide a way to access the picture's property
dialgoue like the form controls do

With a Picture object selected, View > Toolbars > Picture

In future when a Picture is selected, as occurs just after Insert > Picture,
the Picture Toolbar should appear (and disappears when the picture is
deselected).

Not sure if the above clarifies your question (no pun intended).

Regards,
Peter T

 

[Guest]

Hi Peter,

Picture 1 is the name which is given by Excel, like textbox1 which is given
by excel when it is dragged and dropped to a MSForm, but the name textbox1
can be changed inside the property dialgoue at design time, so my question is
whether it is possible to change a picture object's name at desing mode not
using code.

Thank you so much for your all replies! By the way, Could you tell me how
are you using Excel, what kind of development job are you doing? Please
ignore it if you feel uncomfortable to answer them?

Have a wonderful weekend!

Clara

 

[Peter T]

Hi Clara,

In line -

Picture 1 is the name which is given by Excel, like textbox1 which is given
by excel when it is dragged and dropped to a MSForm, but the name textbox1
can be changed inside the property dialgoue at design time, so my question is
whether it is possible to change a picture object's name at desing mode not
using code.

It's only with ActiveX objects that you change properties in the VBE, such
as controls that go on a userform and controls from the 'Controls toolbox'
toolbar for worksheets.

To manually change the name of a Shape or any Drawingobject such as an
inserted picture, select the shape. Then enter the new name in the 'Names
box' left of the input-bar.

Thank you so much for your all replies! By the way, Could you tell me how
are you using Excel, what kind of development job are you doing? Please
ignore it if you feel uncomfortable to answer them?

As it happens I do have quite a large app in development. If you are not
afraid of beta testing you would be most welcome to try it! If interested
contact me for more details -
pmbthornton gmail com (include the at & dot)

Have a wonderful weekend!

Clara

Thanks, you too.

Regards,
Peter T

 

[Guest]

Hi Peter,

I would like to try your beta test. I am not sure what is the beta test
really about, so could you tell me how to do it?
My eamil: (e-mail address removed)
Have a nice day!

Clara

 

[Sarah (OGI)]

I have a similar request to that posed in this thread and I have used the
code identified below to copy all pictures.

However, I am getting a Type Mismatch error when running it. On debug, the
system highlights the word "Next".

Am I missing something?

Thanks
Sarah

 

[Dave Peterson]

Either you changed the code (it worked fine for me) or something bad got
included when you did the copy|paste.

If you changed the code, post your current version.

If you pasted the code, then try deleting that line and just retype that "next"
line.

(Sometimes, copying from a window on the web can get you some extra characters.)

 

[Sarah (OGI)]

Dave

I've tried using this code through a copy/paste, and also by typing it out
from scratch, but both ways result in a run-time error 13, Type Mismatch.
The code being used should match what had previously been suggested:

==========
Sub CopyAllPictures()

Dim r As Long, c As Long
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim pic As Picture

Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

r = wsSource.Rows.Count
c = wsSource.Columns.Count

For Each pic In wsSource.Pictures
With pic.TopLeftCell
If .Row < r Then r = .Row
If .Column < c Then c = .Column
End With
Next

wsDest.Activate
wsDest.Cells(r, c).Activate

wsSource.Pictures.Copy
wsDest.Paste

wsDest.Cells(r, c).Activate

End Sub
=======

Not sure why its not working?

 

[Dave Peterson]

Your code worked fine for me.

What line caused the mismatch error?

 

[Sarah (OGI)]

You know what, I've opened a new session of excel and tried the code once
again, just to be extra sure. This time, however, it seems to work fine -
I'm not sure why it failed before, but its all ok now. Thanks for helping,
although I do have one more issue.....

I've now amended the code to tailor it to my needs. wsDest is now set as
the array of worksheets in my current (active) document, while wsSource is
set as a sheet called "Summary" in another document. (I believe you have
seen my other thread this morning, whereby I have one document, and all
sheets containing charts are copied out (inc. the values and formats, etc)
into a new document). How can I (if possible) reference another sheet in
another workbook?

I've attached the new code below:

========
Sub CopyAllPictures()
Dim r As Long, c As Long
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim pic As Picture

Set wsSource = Worksheets("Summary")
Set wsDest = Worksheets(Array("PC (Chart)-UK-MONTH", "PC (Chart)-NI-MONTH", _
"PC (Chart)-UK&NI-MONTH", "PC (Chart)-UK-YTD", "PC (Chart)-NI-YTD", _
"PC (Chart)-UK&NI-YTD", "PC (Chart)-UK-R12", "PC (Chart)-NI-R12", _
"PC (Chart)-UK&NI-R12", "HH (Chart)-UK-MONTH", "CV (Chart)-UK-MONTH"))

r = wsSource.Rows.Count
c = wsSource.Columns.Count

For Each pic In wsSource.Pictures
With pic.TopLeftCell
If .Row < r Then r = .Row
If .Column < c Then c = .Column
End With
Next

wsDest.Activate
wsDest.Cells(r, c).Activate

wsSource.Pictures.Copy
wsDest.Paste

wsDest.Cells(r, c).Activate

End Sub
========

 

[Peter T]

There doesn't appear to be anything wrong with the code. In your OP you say
the code breaks on the "Next" line (odd). Try commenting all the code except
this

Set wsSource = Worksheets("Sheet1") ' if necessary also qualify with its
workbook

For Each pic In wsSource.Pictures
With pic.TopLeftCell
If .Row < r Then r = .Row
If .Column < c Then c = .Column
End With
Next

msgbox r & " " & c

From your later post, if I follow, you want to loop multiple sheets copying
pictures from looped sheet to another. If you want to use CopyAllPictures in
the loop adapt the two sheet declarations as arguments

Sub CopyAllPictures(wsSource As Worksheet, wsDest As Worksheet)

In your loop, call CopyAllPictures and pass the appropriate source &
destination sheets.

The routine needs to activate the destination sheet in order to ensure the
corresponding top-left cell as relates to ALL the pictures is activated
before doing the Paste. That's to ensure they all get pasted to the right
location in one go. Although not essential, the final step is to deselect
the pasted pictures by selecting a cell, again that requires the destination
sheet to be active. So you will probably want to disable screen updating in
your main routine. Also, you might need to reactivate the sheet that was
originally active (not sure I didn't look at what you are doing)

Regards,
Peter T

 

[Dave Peterson]

You want the wssource worksheet in another workbook?

Set wsSource = workbooks("someotherworkbook.xls").Worksheets("Summary")

That someotherworkbook.xls has to be open.

You know what, I've opened a new session of excel and tried the code once
again, just to be extra sure. This time, however, it seems to work fine -
I'm not sure why it failed before, but its all ok now. Thanks for helping,
although I do have one more issue.....

I've now amended the code to tailor it to my needs. wsDest is now set as
the array of worksheets in my current (active) document, while wsSource is
set as a sheet called "Summary" in another document. (I believe you have
seen my other thread this morning, whereby I have one document, and all
sheets containing charts are copied out (inc. the values and formats, etc)
into a new document). How can I (if possible) reference another sheet in
another workbook?

I've attached the new code below:

========
Sub CopyAllPictures()
Dim r As Long, c As Long
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim pic As Picture

Set wsSource = Worksheets("Summary")
Set wsDest = Worksheets(Array("PC (Chart)-UK-MONTH", "PC (Chart)-NI-MONTH", _
"PC (Chart)-UK&NI-MONTH", "PC (Chart)-UK-YTD", "PC (Chart)-NI-YTD", _
"PC (Chart)-UK&NI-YTD", "PC (Chart)-UK-R12", "PC (Chart)-NI-R12", _
"PC (Chart)-UK&NI-R12", "HH (Chart)-UK-MONTH", "CV (Chart)-UK-MONTH"))

r = wsSource.Rows.Count
c = wsSource.Columns.Count

For Each pic In wsSource.Pictures
With pic.TopLeftCell
If .Row < r Then r = .Row
If .Column < c Then c = .Column
End With
Next

wsDest.Activate
wsDest.Cells(r, c).Activate

wsSource.Pictures.Copy
wsDest.Paste

wsDest.Cells(r, c).Activate

End Sub
========