Changing font in axis label using VBA removes content

[Teckstein]

I have many graphs in a spreadsheet that I use a macro to apply uniform formatting to them. I use this snippet of code

' set y-axis label
.Axes(xlValue).AxisTitle.Select
With Selection.Format.TextFrame2.TextRange.Font
.Size = 10
End With

within the follow script to change the font, but the content of the label is changed from a formula like "=Education!$D$62" to the content of that cell and removes the formula.

Script is

Sub SetGraphDesign()


Dim chtobj As Object
Dim count As Integer




For Each sht In ActiveWorkbook.Sheets


' Set size for all charts on all sheets
    For j = 1 To ActiveSheet.Shapes.count
        If ActiveSheet.Shapes(j).Type = msoChart Then
            ActiveSheet.Shapes(j).Width = 7.5 * 72  ' x * 72 means x is the width in inches
            ActiveSheet.Shapes(j).Height = 5.5 * 72
        End If
    Next j
    
For Each chtobj In sht.ChartObjects
With chtobj.Chart
    
    count = .SeriesCollection.count


'MsgBox ActiveChart.Name




' =========set overall characterisitcs for all graphs===========


' set font


    .ChartArea.Font.Name = "Arial"
' set title font size
    .ChartTitle.Font.Size = 14
    
' set legend font size
    .Legend.Font.Size = 10


' set x-axis label size
    With .Axes(xlCategory).TickLabels.Font
        '.Bold = msoTrue
        .Size = 10
    End With


' set y-axis
    With .Axes(xlValue).TickLabels.Font
            '.Bold = msoTrue
            .Size = 10
    End With
    
' When the follow is present, it removed the formula in the cell and replaces it with just the text
'' set y-axis label
'    .Axes(xlValue).AxisTitle.Select
'    With Selection.Format.TextFrame2.TextRange.Font
'        .Size = 10
'    End With




' ============set column chart characteristics ==================
    If .charttype = xlColumnClustered Then
    
' set overlap -- number is percent of width of a column


    .ChartGroups(1).Overlap = -25






' for first set of columns, this sets the column color
    With .SeriesCollection(1)
        .Interior.Color = RGB(0, 60, 113)
    End With
' this put data label inside lower end, sets decimal place and color


        .SeriesCollection(1).ApplyDataLabels
        .FullSeriesCollection(1).datalabels.Select
            Selection.Position = xlLabelPositionInsideBase
            Selection.NumberFormat = "#,##0.0"
            Selection.Orientation = xlUpward
            Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0
        .Solid
    End With




' repeat for second set of data in series
    If count > 1 Then
    With .SeriesCollection(2)
        .Interior.Color = RGB(0, 102, 245)
    End With




            .SeriesCollection(2).ApplyDataLabels
        .FullSeriesCollection(2).datalabels.Select
            Selection.Position = xlLabelPositionInsideBase
            Selection.NumberFormat = "#,##0.0"
            Selection.Orientation = xlUpward
            Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0
        .Solid
    End With
    End If


  ' checks if there are more than two clusters of columns and then set color, data label
    If count > 2 Then


        With .SeriesCollection(3)
            .Interior.Color = RGB(0, 145, 4)
        End With


        .SeriesCollection(3).ApplyDataLabels
        .FullSeriesCollection(3).datalabels.Select
            Selection.Position = xlLabelPositionInsideBase
            Selection.NumberFormat = "#,##0.0"
            Selection.Orientation = xlUpward
            Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0
        .Solid
    End With


    End If


' repeat of above
    If count > 3 Then


    With .SeriesCollection(4)
        .Interior.Color = RGB(170, 206, 21)
    End With
        .SeriesCollection(4).ApplyDataLabels
        .FullSeriesCollection(4).datalabels.Select
            Selection.Position = xlLabelPositionInsideBase
            Selection.NumberFormat = "#,##0.0"
            Selection.Orientation = xlUpward
            Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With


    End If


    If count > 4 Then
    With .SeriesCollection(5)
        .Interior.Color = RGB(252, 174, 0)
    End With
        .SeriesCollection(5).ApplyDataLabels
        .FullSeriesCollection(5).datalabels.Select
            Selection.Position = xlLabelPositionInsideBase
            Selection.NumberFormat = "#,##0.0"
            Selection.Orientation = xlUpward
            Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With


    End If
    If count > 5 Then


    With .SeriesCollection(6)
        .Interior.Color = RGB(255, 218, 3)
    End With
        .SeriesCollection(6).ApplyDataLabels
        .FullSeriesCollection(6).datalabels.Select
            Selection.Position = xlLabelPositionInsideBase
            Selection.NumberFormat = "#,##0.0"
            Selection.Orientation = xlUpward
            Selection.Format.TextFrame2.Orientation = msoTextOrientationUpward
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With


    End If


End If
' ============= end of section to modify column charts ==================




End With


Next


Next




End Sub

ps - obviously I am not a code writer but an assembler of google search strings!

 

[Worf]

You can set the formula references with code:

Sub SetGraphDesign()
Dim chtobj As ChartObject, sht As Worksheet, count%, j%, cell$
For Each sht In ActiveWorkbook.Sheets
For j = 1 To ActiveSheet.Shapes.count
    If ActiveSheet.Shapes(j).Type = msoChart Then
        ActiveSheet.Shapes(j).Width = 7.5 * 72  ' x * 72 means x is the width in inches
        ActiveSheet.Shapes(j).Height = 5.5 * 72
    End If
Next
For Each chtobj In sht.ChartObjects
    Select Case chtobj.Chart.Name
        Case Is = "sheet1 Chart1"
            cell = "=sheet2!r5c5"       ' cell reference
        Case Is = "sheet1 Chart2"
            cell = "=sheet2!r6c6"
    End Select
    With chtobj.Chart
        count = .SeriesCollection.count
        .ChartArea.Font.Name = "Arial"
        .HasTitle = True
        .ChartTitle.Font.Size = 14
        .HasLegend = True
        .Legend.Font.Size = 10
        With .Axes(xlCategory).TickLabels.Font  ' x-axis
            .Bold = msoTrue
            .Size = 10
        End With
        ' set y-axis
        With .Axes(xlValue).TickLabels.Font
            .Bold = msoTrue
            .Size = 10
        End With
        '' set y-axis label
        .Axes(xlValue).AxisTitle.Format.TextFrame2.TextRange.Font.Size = 12
        .Axes(xlValue).AxisTitle.Text = cell
        If .ChartType = xlColumnClustered Then
            .ChartGroups(1).Overlap = -25   ' number is percent of width of a column
            Block chtobj.Chart, 0, 60, 113, 1, 255, 255, 255
            If count > 1 Then Block chtobj.Chart, 0, 102, 245, 2, 255, 255, 255
            If count > 2 Then Block chtobj.Chart, 0, 145, 4, 3, 255, 255, 255
            If count > 3 Then Block chtobj.Chart, 170, 206, 21, 4, 0, 0, 0
            If count > 4 Then Block chtobj.Chart, 252, 174, 0, 5, 0, 0, 0
            If count > 5 Then Block chtobj.Chart, 255, 218, 3, 6, 0, 0, 0
        End If
    End With
Next
Next
End Sub


Sub Block(ch As Chart, r%, g%, b%, sc%, r2%, g2%, b2%)
Dim dl As DataLabels
ch.SeriesCollection(sc).Interior.Color = RGB(r, g, b)
ch.SeriesCollection(sc).ApplyDataLabels
Set dl = ch.FullSeriesCollection(sc).DataLabels
dl.Position = xlLabelPositionInsideBase
dl.NumberFormat = "#,##0.0"
dl.Orientation = xlUpward
dl.Format.TextFrame2.Orientation = msoTextOrientationUpward
With dl.Format.TextFrame2.TextRange.Font.Fill
    .Visible = msoTrue
    .ForeColor.RGB = RGB(r2, g2, b2)
    .Transparency = 0
    .Solid
End With
End Sub

 

[Teckstein]

Thanks -- I need to study the code a little to understand what you are doing, but you really made it more concise. I will be able to learn a lot from this.

Tom

 

[Worf]

Hi Tom

- You had six blocks of code doing the same thing, so I transformed that into a subroutine, calling it each time with the appropriate parameters.
- Tell me if you have trouble with the code-created formulas.