boumboumjack
New Member
- Joined
- Nov 30, 2010
- Messages
- 6
Hi everyone,
I made some progress since last time I asked a question (copy and paste transpose).
But now I think I have a bug. Each time I create a new chartsheet, the first chart of the SECOND (and 3, 4, 5...) are not sized correctly but The first chart of the first sheet is perfect.
I tried to go step by step until next sheet (step into), first chart, and there it works!
There is the part of my code:
I made some progress since last time I asked a question (copy and paste transpose).
But now I think I have a bug. Each time I create a new chartsheet, the first chart of the SECOND (and 3, 4, 5...) are not sized correctly but The first chart of the first sheet is perfect.
I tried to go step by step until next sheet (step into), first chart, and there it works!
There is the part of my code:
Rich (BB code):
Sub CreateChart2() 'create chart based on column data
Dim Nbr, Cpp, Nbos, MovA, NbO, NbD, Col, Row As Integer ' total number of charts
Dim LineW, HeitC, WidC, PerPo, ScA, ScB, HtB As Double
Dim Ratew, TickW, TickS, TickE, WOpt As Worksheet
Dim Star As Range
' supress chart worksheets
Application.DisplayAlerts = False 'remove alert
For Each Ws In ActiveWorkbook.Sheets
If Left(Ws.Name, 1) = "_" Then
Ws.Delete
End If
Next Ws
Application.DisplayAlerts = True 'restart alert
Set Ratew = Worksheets("rate")
Set WOpt = Worksheets("Option")
Col = WOpt.Range("b8") ' number of chart per row (number of columns)
Row = WOpt.Range("b7") ' number of chart per columns (number of rows)
LineW = Worksheets("option").Range("b10").Value
MovA = Worksheets("option").Range("b14").Value 'moving averag period
NbD = Worksheets("option").Range("t18").Value ' nb of option
Nbr = Range(Ratew.Range("b2"), Ratew.Range("b2").End(xlToRight)).Count 'count the total number of chart to make
Cpp = Col * Row 'number of charts per sheets
Const Large = 795 'sheets dimension widght
Const Haut = 550 'sheet height
Cpp = Col * Row 'number of charts per sheets
HtB = HeitC * (1 - ScB) / (NbD + 2) 'height of textbox
For i = 1 To 2 'Nbos ' create chart sheetS
Sheets.Add After:=Sheets(Sheets.Count), Type:=xlChart
With ActiveSheet.PageSetup 'page setup borders
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.1)
.BottomMargin = Application.InchesToPoints(0.1)
.FooterMargin = Application.InchesToPoints(0.05) ' footer
'.CenterFooter = Ratew.Cells(3, 1).Value & " " & "to" & " " & Ratew.Cells(3, 1).End(xlDown).Value 'footer name
End With
ActiveSheet.Name = "_" & Left(Ratew.Cells(2, 2 + (i - 1) * Cpp).Value, 3) & " " & "to" & " " & _
Left(Ratew.Cells(2, 1 + i * Cpp).Value, 3) & i 'sheet name
With ActiveChart
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
End With
'create chart
For j = 1 To WorksheetFunction.Min(Cpp, Nbr - ((i - 1) * Cpp))
HeitC = Haut / Row ' heit of chart
WidC = Large / Col 'width of chart
With ActiveSheet.ChartObjects.Add _
(Left:=((j - Int((j - 1) / Col) * Col) - 1) * WidC, _
Width:=WidC, _
Top:=1 + (Int((j - 1) / Col)) * HeitC, _
Height:=HeitC)
' position of charts and size
With .Chart
.Type = xlLine
.HasTitle = True
.ChartTitle.Text = Ratew.Cells(2, 1 + j + (i - 1) * Cpp).Value
.ChartTitle.Font.Size = 9
.SeriesCollection.Add Source:=Range(Ratew.Cells(3, 1 + j + (i - 1) * Cpp), Ratew.Cells(3, 1 + j + (i - 1) * Cpp).End(xlDown))
.SeriesCollection(1).MarkerStyle = xlNone
.SeriesCollection(1).Format.Line.Weight = LineW
.HasLegend = False
Application.ScreenUpdating = True
Application.ScreenUpdating = False
End With
End With
Next j ' next chart
Next i 'next sheet
End Sub