Hello All,
I deal with sending data to customers so I need my graphs to look similar. I wrote a routine to make a chart page look consistent starting back in Excel 2007. I am now at Excel 2016 and I needed to update my macros for compatibility.
All charts must be XY Scatter. The code works if there is only 1 Category axis (X axis) and 1 Value axis (Y axis). It will work with both a linear or logarithmic scale for the X axis.
I needed to add a secondary Value axis and now I can not determine what to do if I have a X axis logarithmic scale. I get the Error
"Run-time error '-2147467259 (80004005)':
Method 'ScaleType' of object 'Axis' failed.
I highlighted the line in Red below as to the failure. I can't figure out what I did wrong. I search the forum but could not find an answer.
I am hoping someone could help. Thanks.
Michael Virostko
I deal with sending data to customers so I need my graphs to look similar. I wrote a routine to make a chart page look consistent starting back in Excel 2007. I am now at Excel 2016 and I needed to update my macros for compatibility.
All charts must be XY Scatter. The code works if there is only 1 Category axis (X axis) and 1 Value axis (Y axis). It will work with both a linear or logarithmic scale for the X axis.
I needed to add a secondary Value axis and now I can not determine what to do if I have a X axis logarithmic scale. I get the Error
"Run-time error '-2147467259 (80004005)':
Method 'ScaleType' of object 'Axis' failed.
I highlighted the line in Red below as to the failure. I can't figure out what I did wrong. I search the forum but could not find an answer.
I am hoping someone could help. Thanks.
Michael Virostko
Code:
Option Base 1
Option Explicit
Sub Run_FMT_Chart()
Dim tdiff As Double
Dim tbeg As Double
Dim tend As Double
Dim timebeg As Double
Dim timeend As Double
Dim timestr As String
Dim ntype As Double
Dim ExcelVersion As Integer
ExcelVersion = Application.Version
If 1 = 0 Then
timebeg = Time
tbeg = timebeg
Sheets("Sheet2").Cells(2, 1).FormulaR1C1 = "Beg (TS)"
Sheets("Sheet2").Cells(2, 2).FormulaR1C1 = timebeg
Sheets("Sheet2").Cells(2, 3).FormulaR1C1 = "Beg (#)"
Sheets("Sheet2").Cells(2, 4).FormulaR1C1 = tbeg
End If
Call Reformat_Chart_Page(ExcelVersion, 0)
If 1 = 0 Then
timeend = Time
tend = timeend
Sheets("Sheet2").Cells(3, 1).FormulaR1C1 = "End (TS)"
Sheets("Sheet2").Cells(3, 2).FormulaR1C1 = timeend
Sheets("Sheet2").Cells(3, 3).FormulaR1C1 = "End(#)"
Sheets("Sheet2").Cells(3, 4).FormulaR1C1 = tend
tdiff = CLng(24) * CLng(3600) * (tend - tbeg)
Sheets("Sheet2").Cells(4, 3).FormulaR1C1 = "Diff (#)"
Sheets("Sheet2").Cells(4, 4).FormulaR1C1 = tdiff
timestr = "Time to run Macro = " & Format(tdiff, "0.0000") & " seconds"
ntype = InputBox(timestr, "Time", 0)
End If
End Sub
Sub Reformat_Chart_Page(ExcelVersion As Integer, mlabel As Integer)
' Reformat_Chart_page Macro
' 2006-01-27 Macro recorded by Michael J. Virostko
' 2011-07-14 Revised for Excel 2007 speed.
' Set up Overall Page size along with the Header and Footers
'
' 2016-11-11 Revised to work with Excel 2016
' Aded the ability to log scales and move the text on the scales.
'
Dim ChtType As Variant
Dim borderweight As Variant
Dim Tstring As String
Dim xlogs As Boolean
Dim ylogs As Boolean
Dim testvar As Variant
'
borderweight = 2
ActiveWindow.Zoom = 100
ActiveChart.Activate
Application.ScreenUpdating = False ' do all transfers in the background
Application.DisplayStatusBar = True
'
' Print Page Setup
'
ChtType = ActiveChart.ChartType
'
' Use new subroutine to format page
' First Parameter is to print company name,
' Second parameter is use landscape mode
'
Call Format_Worksheet_print(True, True)
[COLOR="#FF0000"]testvar = ActiveChart.Axes(xlCategory, xlPrimary).ScaleType
[/COLOR] xlogs = False
If ActiveChart.Axes(xlCategory, xlPrimary).ScaleType = xlLogarithmic Then
xlogs = True
End If
ylogs = False
If ActiveChart.Axes(xlValue, xlPrimary).ScaleType = xlLogarithmic Then
ylogs = True
End If
'
' For Excel 2007, Need to define the Chart Area size and area
' Define the Chart area (no border)
' Removed for 2010 have no idea why this will not work.
' Need to add back just for Excel 2007
'
If ExcelVersion > 12 Then
ActiveChart.ChartArea.Select
With Selection
If ExcelVersion = 12 Then
.Top = 0
.Left = 0
.Width = 745 '735
.Height = 530 '530
End If
.Border.LineStyle = xlNone
.Interior.ColorIndex = xlNone
End With
End If
'
' Define the area for the plot
'
ActiveChart.PlotArea.Select
With Selection
.Top = 75
.Left = 25
.Width = 690
.Height = 410
End With
'
' Format the plot area for white background, solid border.
'
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 1
.Weight = borderweight + 0.5
.LineStyle = xlContinuous
End With
Selection.Interior.ColorIndex = xlNone
'
' Set up graph to have only major gridlines
'
With ActiveChart.Axes(xlCategory, xlPrimary)
.HasMajorGridlines = True
If xlogs Then
.HasMinorGridlines = True
Else
.HasMinorGridlines = False
End If
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
If ylogs Then
.HasMinorGridlines = True
Else
.HasMinorGridlines = False
End If
End With
'
' Set up major gridlines to be a dashed line
'
' xlCategory represents x
' xlvalue represents y
'
' Format the Chart Title
'
If ActiveChart.HasTitle = False Then
ActiveChart.HasTitle = True
End If
ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Bold"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
'
' Reformat the X-Axis
'
If ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = False Then
ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
Else
Tstring = ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Caption
ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = False
ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Tstring
End If
ActiveChart.Axes(xlCategory, xlPrimary).MajorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0) ' Black
.Weight = borderweight + 0.5
.LineStyle = xlDash
End With
ActiveChart.Axes(xlCategory, xlPrimary).Select
With Selection
.MajorTickMark = xlCross
.MinorTickMark = xlInside
.TickLabelPosition = xlLow
.Crosses = xlCustom
If ChtType > 71 And ChtType < 76 Then
If xlogs Then
.CrossesAt = 0.00001
Else
.CrossesAt = -2000
End If
.ReversePlotOrder = False
.DisplayUnit = xlNone
End If
End With
ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
'
' ActiveChart.Axes(xlCategory, xlPrimary).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.ReadingOrder = xlContext
.Orientation = xlHorizontal
' .Top = xlAuto
End With
ActiveChart.Axes(xlCategory, xlPrimary).MajorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0)
If xlogs Then
.Weight = borderweight
.LineStyle = xlSolid
Else
.Weight = xlHairline
.LineStyle = xlDash
End If
End With
If xlogs Then
If ActiveChart.Axes(xlCategory, xlPrimary).HasMinorGridlines = False Then
ActiveChart.Axes(xlCategory, xlPrimary).HasMinorGridlines = True
End If
ActiveChart.Axes(xlCategory, xlPrimary).MinorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0)
.Weight = borderweight - 1
.LineStyle = xlDash
End With
End If
'
' Reformat the Y-Axis
'
If ActiveChart.Axes(xlValue, xlPrimary).HasTitle = False Then
ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
Else
Tstring = ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Caption
ActiveChart.Axes(xlValue, xlPrimary).HasTitle = False
ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Tstring
End If
ActiveChart.Axes(xlValue, xlPrimary).MajorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0) ' Black
.Weight = borderweight + 0.5
.LineStyle = xlDash
End With
ActiveChart.Axes(xlValue, xlPrimary).Select
With Selection
.MajorTickMark = xlCross
.MinorTickMark = xlInside
.TickLabelPosition = xlLow
.Crosses = xlCustom
If ChtType > 71 And ChtType < 76 Then
If xlogs Then
.CrossesAt = 0.00001
Else
.CrossesAt = -2000
End If
.ReversePlotOrder = False
.DisplayUnit = xlNone
End If
End With
ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
'
' ActiveChart.Axes(xlValue, xlPrimary, xlPrimary).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlUpward
End With
ActiveChart.Axes(xlValue, xlPrimary).MajorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0)
If xlogs Then
.Weight = borderweight
.LineStyle = xlSolid
Else
.Weight = xlHairline
.LineStyle = xlDash
End If
End With
If xlogs Then
If ActiveChart.Axes(xlValue, xlPrimary).HasMinorGridlines = False Then
ActiveChart.Axes(xlValue, xlPrimary).HasMinorGridlines = True
End If
ActiveChart.Axes(xlValue, xlPrimary).MinorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0)
.Weight = borderweight - 1
.LineStyle = xlDash
End With
End If
'
' Reformat the Secondary Y-Axis
'
If ActiveChart.Axes.Count > 2 Then
If ActiveChart.Axes(xlValue, xlSecondary).HasTitle = False Then
ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True
Else
Tstring = ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Caption
ActiveChart.Axes(xlValue, xlSecondary).HasTitle = False
ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True
ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = Tstring
End If
If 1 = 0 Then
ActiveChart.Axes(xlValue, xlSecondary).MajorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0) ' Black
.Weight = borderweight + 0.5
.LineStyle = xlDash
End With
End If
ActiveChart.Axes(xlValue, xlSecondary).Select
With Selection
.MajorTickMark = xlCross
.MinorTickMark = xlInside
.TickLabelPosition = xlLow
.Crosses = xlCustom
If ChtType > 71 And ChtType < 76 Then
If xlogs Then
.CrossesAt = 0.00001
Else
.CrossesAt = -2000
End If
.ReversePlotOrder = False
.DisplayUnit = xlNone
End If
End With
ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Select
Selection.AutoScaleFont = True
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
'
' ActiveChart.Axes(xlValue, xlSecondary, xlPrimary).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Orientation = xlUpward
End With
ActiveChart.Axes(xlValue, xlSecondary).MajorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0)
If xlogs Then
.Weight = borderweight
.LineStyle = xlSolid
Else
.Weight = xlHairline
.LineStyle = xlDash
End If
End With
If xlogs Then
If ActiveChart.Axes(xlValue, xlSecondary).HasMinorGridlines = False Then
ActiveChart.Axes(xlValue, xlSecondary).HasMinorGridlines = True
End If
ActiveChart.Axes(xlValue, xlSecondary).MinorGridlines.Select
With Selection.Border
.Color = RGB(0, 0, 0)
.Weight = borderweight - 1
.LineStyle = xlDash
End With
End If
End If
'
' Force Legend to have a border, white soldid fill.
'
ActiveChart.Legend.Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlContinuous
End With
Selection.Shadow = False
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With
' Selection.Interior.ColorIndex = xlNone
Selection.AutoScaleFont = False
With Selection.Font
.Name = "Times New Roman"
.FontStyle = "Regular"
.Size = 12 ' 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
.Background = xlTransparent
End With
Application.ScreenUpdating = True ' do all transfers in the background
End Sub