Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Trying to Learn Code to Copy Charts
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 24
Default Trying to Learn Code to Copy Charts
Hi,

I have the following code to copy two charts from 'Bookings' sheet and paste
to several other sheets along with other details after the paste on each
sheet. I used the macro recorder to do this as I am so new to vba and took
out what I thought wound not be needed. It works as I want, but as you can
see the code repeats itself for every sheet. There will be 12 in all. Can
someone teach me how to group all the 'paste to' sheets and still have it
update with the correct source data for each chart on each sheet? I have the
two lines of code that are in question flagged below.

Sub ChartCopyCode()
'
Sheets("Bookings").Select
ActiveSheet.Shapes.Range(Array(1, 2)).Select
Selection.Copy

Sheets("Bk01-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W2:Y17"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W21:Y31"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With

Sheets("Bk02-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W2:Y17"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W21:Y31"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
End Sub

Any help with be greatly appreciated.
Thanks in advance.
Phisaw


Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 703
Default Trying to Learn Code to Copy Charts
Hi

You can create an array variable, with all sheet names to paste to.
Then you can use a loop to paste charts and change the sheet
reference:

Sub ChartCopyCode()
'
Dim ShArr
ShArr = Split("Bk01-09,Bk02-09,Bk03-09", ",")
Sheets("Bookings").Shapes.Range(Array(1, 2)).Copy
For c = LBound(ShArr) To UBound(ShArr)

Sheets(ShArr(c)).Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse,
msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W2:Y17"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With


ActiveSheet.ChartObjects(1).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W21:Y31"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
Next
Application.CutCopyMode = False
End Sub

Regards,
Per

On 23 Okt., 22:13, PHisaw wrote:
Hi,

I have the following code to copy two charts from 'Bookings' sheet and paste
to several other sheets along with other details after the paste on each
sheet. *I used the macro recorder to do this as I am so new to vba and took
out what I thought wound not be needed. *It works as I want, but as you can
see the code repeats itself for every sheet. *There will be 12 in all. *Can
someone teach me how to group all the 'paste to' sheets and still have it
update with the correct source data for each chart on each sheet? *I have the
two lines of code that are in question flagged below. *

Sub ChartCopyCode()
'
* * Sheets("Bookings").Select
* * ActiveSheet.Shapes.Range(Array(1, 2)).Select
* * Selection.Copy

* * Sheets("Bk01-09").Select
* * Columns("R:R").ColumnWidth = 20
* * Columns("Y:Y").ColumnWidth = 20
* * Range("Q1").Select
* * ActiveSheet.Paste
* * ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
* * ActiveSheet.ChartObjects(2).Activate

***** * *ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W2:Y17"), PlotBy _
* * * * :=xlColumns

* * ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * ActiveChart.SeriesCollection(1).Select
* * With Selection.Interior
* * * * .ColorIndex = 6
* * * * .Pattern = xlSolid
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Vendor Monthly Bookings "
* * End With

* * ActiveSheet.ChartObjects(1).Activate

**** * *ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W21:Y31"), PlotBy _
* * * * :=xlColumns

* * ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Slsp Monthly Bookings "
* * End With

* * Sheets("Bk02-09").Select
* * Columns("R:R").ColumnWidth = 20
* * Columns("Y:Y").ColumnWidth = 20
* * Range("Q1").Select
* * ActiveSheet.Paste
* * ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
* * ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W2:Y17"),
PlotBy _
* * * * :=xlColumns

* *ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * ActiveChart.SeriesCollection(1).Select
* * With Selection.Interior
* * * * .ColorIndex = 6
* * * * .Pattern = xlSolid
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Vendor Monthly Bookings "
* * End With

* * ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W21:Y31"),
PlotBy _
* * * * :=xlColumns

*ActiveChart.SeriesCollection(1).Delete
* * ActiveChart.SeriesCollection(1).DataLabels.Select
* * With Selection.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlCategory)
* * * * .ReversePlotOrder = True
* * * * .Crosses = xlMaximum
* * End With
* * With ActiveChart.Axes(xlCategory).TickLabels.Font
* * * * * * .Name = "Arial"
* * * * * * .Size = 7
* * End With
* * With ActiveChart.Axes(xlValue).TickLabels.Font
* * * * .Name = "Arial"
* * * * .Size = 7
* * End With
* * With ActiveChart
* * * * .HasTitle = True
* * * * .ChartTitle.Characters.Text = "Slsp Monthly Bookings "
* * End With
* * End Sub

Any help with be greatly appreciated.
Thanks in advance.
Phisaw

Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 24
Default Trying to Learn Code to Copy Charts
Per Jessen,

Thank you for replying with explanation and code to group all sheets in an
array. There was one line of code that gave me an "object does not support
this method" error, so I just pasted what I originally had and it worked.
Still much shorter than all the same code for 12 worksheets.

Here's the line that threw the error:

Sheets("Bookings").Shapes.Range(Array(1, 2)).Copy

and I went back with this:

Sheets("Bookings").Select
ActiveSheet.Shapes.Range(Array(1, 2)).Select
Selection.Copy

Thanks again for your help.
Phisaw

"Per Jessen" wrote:

Hi

You can create an array variable, with all sheet names to paste to.
Then you can use a loop to paste charts and change the sheet
reference:

Sub ChartCopyCode()
'
Dim ShArr
ShArr = Split("Bk01-09,Bk02-09,Bk03-09", ",")
Sheets("Bookings").Shapes.Range(Array(1, 2)).Copy
For c = LBound(ShArr) To UBound(ShArr)

Sheets(ShArr(c)).Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse,
msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W2:Y17"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With


ActiveSheet.ChartObjects(1).Activate
ActiveChart.SetSourceData Source:=Sheets(ShArr(c)).Range
("W21:Y31"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
Next
Application.CutCopyMode = False
End Sub

Regards,
Per

On 23 Okt., 22:13, PHisaw wrote:
Hi,

I have the following code to copy two charts from 'Bookings' sheet and paste
to several other sheets along with other details after the paste on each
sheet. I used the macro recorder to do this as I am so new to vba and took
out what I thought wound not be needed. It works as I want, but as you can
see the code repeats itself for every sheet. There will be 12 in all. Can
someone teach me how to group all the 'paste to' sheets and still have it
update with the correct source data for each chart on each sheet? I have the
two lines of code that are in question flagged below.

Sub ChartCopyCode()
'
Sheets("Bookings").Select
ActiveSheet.Shapes.Range(Array(1, 2)).Select
Selection.Copy

Sheets("Bk01-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W2:Y17"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData
Source:=Sheets("Bk01-09").Range("W21:Y31"), PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With

Sheets("Bk02-09").Select
Columns("R:R").ColumnWidth = 20
Columns("Y:Y").ColumnWidth = 20
Range("Q1").Select
ActiveSheet.Paste
ActiveSheet.Shapes(1).ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
ActiveSheet.ChartObjects(2).Activate

***** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W2:Y17"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Vendor Monthly Bookings "
End With

ActiveSheet.ChartObjects(1).Activate

**** ActiveChart.SetSourceData Source:=Sheets("Bk02-09").Range("W21:Y31"),
PlotBy _
:=xlColumns

ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlCategory)
.ReversePlotOrder = True
.Crosses = xlMaximum
End With
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart.Axes(xlValue).TickLabels.Font
.Name = "Arial"
.Size = 7
End With
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Slsp Monthly Bookings "
End With
End Sub

Any help with be greatly appreciated.
Thanks in advance.
Phisaw

.

Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Learn Macro & VB Code that usually put in Excel. Invisible Excel Worksheet Functions 1 May 5th 09 05:00 PM
Creating charts with VBA code Ayo Charts and Charting in Excel 2 April 8th 09 12:08 PM
Copy/Paste Charts; Define Destination of Charts in PowerPoint ryguy7272 Excel Programming 2 January 24th 08 08:04 PM
Creating Charts in VBA Code [email protected] Excel Programming 4 April 13th 05 07:21 AM
Code to copy range vs Copy Entire Worksheet - can't figure it out Mike Taylor Excel Programming 1 April 15th 04 08:34 PM


All times are GMT +1. The time now is 01:39 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement