copying the objects from a sheet
 

I am trying to write code to copy the objects (logos, graphics, etc) from
one sheet to another, and have them come up in the same place on the
destination sheet.

At the moment, it's putting them somewhere near but not quite at the top of
the sheet and shifting them left a bit

Is there a way to get them to go in the same place?

Here's the code that isn't working:
Sheets("Sheet1").Select
ActiveSheet.DrawingObjects.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
Link:=False, _
DisplayAsIcon:=False
'=====================

Thanks

M

copying the objects from a sheet
 

why not create a tempalte worksheet and just copy the template when you
start a new worksheet. The template can either be a sheet in the
workbook or in a seperate workbook.


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?u=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=202154

http://www.thecodecage.com/forumz

copying the objects from a sheet
 

Things work slightly differently in 97-2003 and later versions. This isn't
optimal for either but should work in both (but note the ActiveX caveat)

Sub test1()
Dim i As Long, j As Long, first As Long
Dim sAddr As String
Dim shtOrig As Object
Dim dwOb As Object
Dim dwObs As Object

' don't use this if ActiveX controls being copied

Set dwObs = Worksheets("Sheet1").DrawingObjects
If dwObs.Count = 0 Then Exit Sub

dwObs.Copy

Worksheets("Sheet2").Paste

With Worksheets("Sheet2").DrawingObjects

For i = .Count - dwObs.Count + 1 To .Count
j = j + 1
With .Item(i)
.Left = dwObs(j).Left
.Top = dwObs(j).Top
End With
Next

End With

' optional deselect the objects
' Worksheets("Sheet2").Activate
' ActiveCell.Select

End Sub

Regards,
Peter T


"Michelle" wrote in message
...
I am trying to write code to copy the objects (logos, graphics, etc) from
one sheet to another, and have them come up in the same place on the
destination sheet.

At the moment, it's putting them somewhere near but not quite at the top
of the sheet and shifting them left a bit

Is there a way to get them to go in the same place?

Here's the code that isn't working:
Sheets("Sheet1").Select
ActiveSheet.DrawingObjects.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
Link:=False, _
DisplayAsIcon:=False
'=====================

Thanks

M

copying the objects from a sheet
 

Peter - that is BRILLIANT!

Thank you

M


"Peter T" <peter_t@discussions wrote in message
...
Things work slightly differently in 97-2003 and later versions. This isn't
optimal for either but should work in both (but note the ActiveX caveat)

Sub test1()
Dim i As Long, j As Long, first As Long
Dim sAddr As String
Dim shtOrig As Object
Dim dwOb As Object
Dim dwObs As Object

' don't use this if ActiveX controls being copied

Set dwObs = Worksheets("Sheet1").DrawingObjects
If dwObs.Count = 0 Then Exit Sub

dwObs.Copy

Worksheets("Sheet2").Paste

With Worksheets("Sheet2").DrawingObjects

For i = .Count - dwObs.Count + 1 To .Count
j = j + 1
With .Item(i)
.Left = dwObs(j).Left
.Top = dwObs(j).Top
End With
Next

End With

' optional deselect the objects
' Worksheets("Sheet2").Activate
' ActiveCell.Select

End Sub

Regards,
Peter T


"Michelle" wrote in message
...
I am trying to write code to copy the objects (logos, graphics, etc) from
one sheet to another, and have them come up in the same place on the
destination sheet.

At the moment, it's putting them somewhere near but not quite at the top
of the sheet and shifting them left a bit

Is there a way to get them to go in the same place?

Here's the code that isn't working:
Sheets("Sheet1").Select
ActiveSheet.DrawingObjects.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
Link:=False, _
DisplayAsIcon:=False
'=====================

Thanks

M

copying the objects from a sheet
 

That's nice, glad it worked :-)

I see there are some unused variable declarations you can get rid of (that
I'd used in earlier testing)

Regards,
Peter T


"Michelle" wrote in message
...
Peter - that is BRILLIANT!

Thank you

M


"Peter T" <peter_t@discussions wrote in message
...
Things work slightly differently in 97-2003 and later versions. This
isn't optimal for either but should work in both (but note the ActiveX
caveat)

Sub test1()
Dim i As Long, j As Long, first As Long
Dim sAddr As String
Dim shtOrig As Object
Dim dwOb As Object
Dim dwObs As Object

' don't use this if ActiveX controls being copied

Set dwObs = Worksheets("Sheet1").DrawingObjects
If dwObs.Count = 0 Then Exit Sub

dwObs.Copy

Worksheets("Sheet2").Paste

With Worksheets("Sheet2").DrawingObjects

For i = .Count - dwObs.Count + 1 To .Count
j = j + 1
With .Item(i)
.Left = dwObs(j).Left
.Top = dwObs(j).Top
End With
Next

End With

' optional deselect the objects
' Worksheets("Sheet2").Activate
' ActiveCell.Select

End Sub

Regards,
Peter T


"Michelle" wrote in message
...
I am trying to write code to copy the objects (logos, graphics, etc) from
one sheet to another, and have them come up in the same place on the
destination sheet.

At the moment, it's putting them somewhere near but not quite at the top
of the sheet and shifting them left a bit

Is there a way to get them to go in the same place?

Here's the code that isn't working:
Sheets("Sheet1").Select
ActiveSheet.DrawingObjects.Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.PasteSpecial Format:="MS Office Drawing Object",
Link:=False, _
DisplayAsIcon:=False
'=====================

Thanks

M