Floating Bar Chart 1004 error

O

Oz Viking

This seems to work for one set of data but not when run on other data.

Sub PrintChartReport()

Dim Msg As String
Dim MsgConfig As VbMsgBoxStyle
Dim MsgTitle As String
Dim MsgAns As VbMsgBoxResult
Dim RecsPerPage As Integer
Dim RecCounter As Integer
Dim TotalRecs As Integer
Dim RecPage As Integer
Dim RecPages As Integer
Dim NumberOfCopies As Integer
Dim InputBoxResult As String

Msg = vbLf & vbLf
Msg = Msg & "Number of records to Print = " &
Str(wsData.Range("L1").Value) & " " & vbLf & vbLf
MsgConfig = vbInformation
MsgTitle = "QBuild SSoT Program - READY TO PRINT "
MsgBox Msg, MsgConfig, MsgTitle

InputBoxResult = InputBox("Number of reports to Print?", "COPIES TO
PRINT ", "1")
If InputBoxResult = "" Then Exit Sub
NumberOfCopies = CInt(InputBoxResult)

wsData.Range("I2").Select
Application.ScreenUpdating = False

Charts("SSoT Chart").Select
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="Floating
Bars"
ActiveChart.SetSourceData _
Source:=wsData.Range("I1:K" & Trim(Str(wsData.Range("L1").Value +
1))), _
PlotBy:=xlColumns
ActiveChart.Location _
Where:=xlLocationAsNewSheet
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "SSoT - BM Program"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Characters.Text = "Complex Name"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = "Estimated Project Period"
.Axes(xlSeries).HasTitle = False
End With
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlSeries)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
ActiveChart.WallsAndGridlines2D = True
ActiveChart.HasDataTable = False

ActiveChart.ChartArea.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
With Selection
.Shadow = False
.Interior.ColorIndex = xlNone
.AutoScaleFont = True
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

'Chart Title specifications
ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With

'Chart Category (Complex Names) specifications
ActiveChart.Axes(xlCategory).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlUpward
End With
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection.TickLabels
.Alignment = xlCenter
.Offset = 100
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With
With ActiveChart.Axes(xlCategory)
.TickLabelSpacing = 1
.TickMarkSpacing = 1
.ReversePlotOrder = True
.AxisBetweenCategories = True
End With

'Chart Values (Dates) specifications
ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
With Selection.TickLabels
.NumberFormat = "dd-mmm-yyyy;@"
.ReadingOrder = xlContext
.Orientation = 45
End With

'Define Series 1 (Start Date) data details
ActiveChart.SeriesCollection(1).HasDataLabels = True

ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 7
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

ActiveChart.SeriesCollection(1).ApplyDataLabels _
AutoText:=True, _
LegendKey:=False, _
ShowSeriesName:=True, _
ShowCategoryName:=False, _
ShowValue:=True, _
ShowPercentage:=False, _
ShowBubbleSize:=False, _
Separator:=" "

With Selection
.NumberFormat = "dd-mmm-yyyy;@"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With

'Define Series 2 (Days) data details
'*** Stops here and says it cannot find SeriesCollection Chart Class
ActiveChart.SeriesCollection(2).HasDataLabels = True

ActiveChart.SeriesCollection(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.InvertIfNegative = False
Selection.Fill.OneColorGradient _
Style:=msoGradientVertical, _
Variant:=1, _
Degree:=0.349019607843137

With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 44
.BarShape = xlBox
End With

ActiveChart.SeriesCollection(2).ApplyDataLabels _
AutoText:=True, _
LegendKey:=False, _
ShowSeriesName:=True, _
ShowCategoryName:=False, _
ShowValue:=True, _
ShowPercentage:=False, _
ShowBubbleSize:=False, _
Separator:=" "

With ActiveChart
.ChartGroups(1).GapWidth = 20
.DepthPercent = 20
.GapDepth = 300
End With

ActiveChart.SeriesCollection(2).DataLabels.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 7
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With

With Selection
.NumberFormat = "#,##0_ ;[Red](#,##0) "
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With

'Select and print records
RecsPerPage = 55
wsData.Range("M1").Value = RecsPerPage
RecCounter = 0
TotalRecs = wsData.Range("L1").Value
RecPage = 0
RecPages = wsData.Range("N1").Value

'Select the chart sheet
Sheets("SSoT Chart").Select
ActiveChart.PlotArea.Select

For RecPage = 1 To RecPages

If RecPage = RecPages Then
ActiveChart.SetSourceData Source:=wsData.Range("I1:K1,I" &
RecCounter + 2 & ":K" & _
Trim(Str(TotalRecs + 1))), PlotBy:=xlColumns
Else
ActiveChart.SetSourceData Source:=wsData.Range("I1:K1,I" &
RecCounter + 2 & ":K" & _
Trim(Str(RecPage * RecsPerPage + 1))), PlotBy:=xlColumns
End If

With ActiveChart.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&8LEIF PEDERSEN - MAINTENANCE"
.CenterFooter = "&8" + Str(RecPage) + " of " + Str(RecPages)
.RightFooter = "&8&D"
.LeftMargin = 30
.RightMargin = 30
.TopMargin = 30
.BottomMargin = 45
.HeaderMargin = 30
.FooterMargin = 30
.ChartSize = xlFullPage
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.BlackAndWhite = False
.Zoom = 100
End With

ActiveWindow.SelectedSheets.PrintOut Copies:=NumberOfCopies,
Collate:=True
RecCounter = RecCounter + RecsPerPage

Next RecPage

'Return to the Data sheet and tidy up
wsData.Select
Range("A2").Select
Application.ScreenUpdating = True

Msg = vbLf & vbLf
Msg = Msg & "Printing has finished. Retrieve the charts from the
printer. " & vbLf & vbLf
MsgConfig = vbInformation
MsgTitle = "QBuild SSoT Program - FINISHED PRINTING "
MsgBox Msg, MsgConfig, MsgTitle

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro Error 1
Error 1004 - Unable to set invertifnegative 7
How to rewrite this code? (first half) 1
How to rewrite this code? (Second half) 1
Change code help 0
Superscrpts in Excel 2007 Text boxes 0
Page Setup not working in macro 1
Autofill Error 4

Top