Group Names Change Upon Paste, Kills Code.

[Bull Splat]

I have a workbook with 52 work sheets, and each worksheet has two
charts. I didn't like the legend that Excel made, so I created my own
legend with rectangles (different colors) and text boxes with the
legend information. I created this legend on the first worksheet, and
"planned" to have a macro just select, copy, paste, and place the
legend into each following worksheet.
Well, the macro runs OK, but just once, then the rectangle (a group of
several boxes grouped together) gets a NEW name, Oh Great! SO the
macro bails out.

I've tried giving the legend a name, ("Legend"), then I tried calling
that from the macro, no luck.

And, of someone can tell me how to get the macro to work though all of
the worksheets, it would sure save me a TON of time.

Here,s the code, please help....



Sub Copy_Legend_Chart1()
'
' Copy_Legend_Chart1 Macro
' Macro recorded 02/06/2004 by Default
'
' Keyboard Shortcut: Ctrl+Shift+B
'
Application.Goto Reference:="R90C19"
ActiveSheet.ChartObjects("Chart 1").Activate
'The following line is where it freezes up after one run
ActiveChart.Shapes("Group 26").Select
Selection.Copy
ActiveWindow.Visible = False
ActiveSheet.Next.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.Paste
Selection.ShapeRange.IncrementLeft 676.99
ActiveWindow.Visible = False
Windows("TimeAudit23-03.xls").Activate
Range("G64").Select
ActiveSheet.Next.Select
End Sub

 

[Bull Splat]

Well, last night, at about 1 AM, I had a brain flash, "Save the legend
as a "Jpeg" picture. Yeah, well, that doesn't work either. Every
time the picture is "pasted" into a new worksheet, it gets a new
number.
How do I declare the legend or the picture so all the worksheets can
utilize it? Many Thanks.

 

[Dave Peterson]

One way to use the picture multiple times:

Option Explicit
Sub testme01()

Dim myPic As Picture
Dim wks As Worksheet
Dim myCopiedPicture As Picture
Dim AlreadyLoadedFromDisk As Boolean

AlreadyLoadedFromDisk = False
For Each wks In Worksheets
With wks
'kill existing picture named myPict
On Error Resume Next
Do
.Pictures("myPict").Delete
If Err.Number <> 0 Then
Err.Clear
Exit Do
End If
Loop
On Error GoTo 0

If AlreadyLoadedFromDisk = False Then
Set myPic = .Pictures.Insert("C:\legend.jpg")
myPic.Name = "MyPict"
AlreadyLoadedFromDisk = True
Else
myPic.Copy
.Paste
End If

Set myCopiedPicture = .Pictures(.Pictures.Count)
With myCopiedPicture
.Top = .Parent.Range("a1").Top
.Left = .Parent.Range("a1").Left
.Width = .Parent.Range("a1:b1").Width
.Height = .Parent.Range("a1:a3").Height
End With

End With
Next wks

End Sub


Maybe you can go use some of this junk to go back to your original technique????

 

[Doug Glancy]

This is about as good as I'm going to be able to do with this. It copies
Group 26 from Chart1 in a worksheet named "original sheet". It copies the
group to each chart in each other sheet and puts it in the same position. I
should be able to do this without any activate commands, but can't figure
the syntax.

Sub test()

Dim sh As Worksheet
Dim ch As ChartObject
Dim shape_left As Long, shape_top As Long

ActiveWorkbook.Worksheets("original sheet").ChartObjects("Chart 1").Activate
With ActiveChart.Shapes("Group 26")
shape_left = .left
shape_top = .top
.Copy
End With

For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> "original sheet" Then
For Each ch In sh.ChartObjects
ch.Activate
ActiveChart.Paste
With Selection
.left = shape_left
.top = shape_top
End With
Next ch
End If
Next sh

hth,

Doug


End Sub