Changing font in axis label using VBA removes content

Teckstein

New Member
Joined
Sep 24, 2012
Messages
11
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
Code:
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!
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
4,129
You can set the formula references with code:


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

New Member
Joined
Sep 24, 2012
Messages
11
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

Well-known Member
Joined
Oct 30, 2011
Messages
4,129
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,493
Messages
5,636,641
Members
416,932
Latest member
mm07

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top