ianb
Member
Hi,
I have been going at this for 1 hour and I am a little lost at the moment.
Here is my code with the two other parts listed below which I can not add to my program to make the chart resizing work.
The title is set to 14. I need the other font size to be set to 8 for all the other text and numbers on the charts.
Sub ChartTitles()
Dim ws As Worksheet
Dim ch As ChartObject
For Each ws In Worksheets
For Each ch In ws.ChartObjects
ch.Activate
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 18
ActiveChart.ClearToMatchStyle
Next ch
Next ws
'Font Size and Colour in Charts
'Dim ws As Worksheet
'Dim ch As ChartObject
Dim Fnt As String
Dim FntSz As Double
Dim FntR As Integer
Dim FntG As Integer
Dim FntB As Integer
Dim ax As Axis
Fnt = "Rockwell (Body)" 'Set Font type
FntSz = 14 'Set Font Size
FntSzs = 8 'Set Font Size Small
'Black Text
FntR = 0 'Set Font Color Red
FntG = 0 'Set Font Color Green
FntB = 0 'Set Font Color Blue
For Each ws In Worksheets
For Each ch In ws.ChartObjects
ch.Activate
ch.Chart.ChartTitle.Select
With Selection.Font.Name = Fnt
Selection.Font.Size = FntSz
Selection.Font.Color = RGB(FntR, FntG, FntB)
Application.Goto Range("a1")
End With
Next ch
Next ws
Application.Run "PivotTableConfigLight"
'Application.Run "BoxChangeColLight"
Sheets("Dashboard (Overview)").Select
End Sub
Second Attempt.
' ch.Chart.Axes(xlCategory).TickLabels.Select
' With Selection.Font.Name = Fnt
' Selection.Font.Size = FntSzs
' Selection.Font.Color = RGB(FntR, FntG, FntB)
' End With
'
' ch.Chart.Axes(xlValue).TickLabels.Select
' With Selection.Font.Name = Fnt
' Selection.Font.Size = FntSzs
' Selection.Font.Color = RGB(FntR, FntG, FntB)
' Application.Goto Range("a1")
' End With
Code given to me to add.
'Dim typelist As Variant, mr As Variant
'Dim ct As Integer
'
'typelist = Array(xlColumnStacked, xlColumnClustered, xlLineMarkers, xl3DPieExploded)
'ct = ch.Chart.ChartType
'On Error Resume Next
'mr = Null
'mr = Application.WorksheetFunction.Match(ct, typelist, 0)
'On Error GoTo 0
'
'If IsNull(mr) Then
' ch.Chart.Axes(xlCategory).TickLabels.Font.Size = 8
'ch.Chart.Axes(xlValues).TickLabels.Font.Size = 8
'End If
I have been going at this for 1 hour and I am a little lost at the moment.
Here is my code with the two other parts listed below which I can not add to my program to make the chart resizing work.
The title is set to 14. I need the other font size to be set to 8 for all the other text and numbers on the charts.
Sub ChartTitles()
Dim ws As Worksheet
Dim ch As ChartObject
For Each ws In Worksheets
For Each ch In ws.ChartObjects
ch.Activate
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 18
ActiveChart.ClearToMatchStyle
Next ch
Next ws
'Font Size and Colour in Charts
'Dim ws As Worksheet
'Dim ch As ChartObject
Dim Fnt As String
Dim FntSz As Double
Dim FntR As Integer
Dim FntG As Integer
Dim FntB As Integer
Dim ax As Axis
Fnt = "Rockwell (Body)" 'Set Font type
FntSz = 14 'Set Font Size
FntSzs = 8 'Set Font Size Small
'Black Text
FntR = 0 'Set Font Color Red
FntG = 0 'Set Font Color Green
FntB = 0 'Set Font Color Blue
For Each ws In Worksheets
For Each ch In ws.ChartObjects
ch.Activate
ch.Chart.ChartTitle.Select
With Selection.Font.Name = Fnt
Selection.Font.Size = FntSz
Selection.Font.Color = RGB(FntR, FntG, FntB)
Application.Goto Range("a1")
End With
Next ch
Next ws
Application.Run "PivotTableConfigLight"
'Application.Run "BoxChangeColLight"
Sheets("Dashboard (Overview)").Select
End Sub
Second Attempt.
' ch.Chart.Axes(xlCategory).TickLabels.Select
' With Selection.Font.Name = Fnt
' Selection.Font.Size = FntSzs
' Selection.Font.Color = RGB(FntR, FntG, FntB)
' End With
'
' ch.Chart.Axes(xlValue).TickLabels.Select
' With Selection.Font.Name = Fnt
' Selection.Font.Size = FntSzs
' Selection.Font.Color = RGB(FntR, FntG, FntB)
' Application.Goto Range("a1")
' End With
Code given to me to add.
'Dim typelist As Variant, mr As Variant
'Dim ct As Integer
'
'typelist = Array(xlColumnStacked, xlColumnClustered, xlLineMarkers, xl3DPieExploded)
'ct = ch.Chart.ChartType
'On Error Resume Next
'mr = Null
'mr = Application.WorksheetFunction.Match(ct, typelist, 0)
'On Error GoTo 0
'
'If IsNull(mr) Then
' ch.Chart.Axes(xlCategory).TickLabels.Font.Size = 8
'ch.Chart.Axes(xlValues).TickLabels.Font.Size = 8
'End If