Reputation: 41
I have a form in Access 2007 with a Stacked Bar Chart Object that is dynamically generated depending on the current date and outputs a PDF of the chart.
Everything generates and works fine, but what is happening is data labels are being applied even for series with a Null or 0 value. This leads to a mess of text in various places.
I'm looking for a way via VBA to remove any labels that belong to a series with no values.
I've tried ruling out null values from the SQL query and also setting the format options so the 0 values won't show. I have tried looping through the series and applying a label if the value is > 0, but if I set it to apply the series name it still puts it for blank values.
EDIT Current Code:
Option Compare Database
Private Sub Form_Load()
Dim tstChart As Graph.Chart
On Error GoTo Form_Load_Error
Set tstChart = [Forms]!testing!barEquip.Object
With tstChart
.HasTitle = True
.ChartTitle.Font.Size = 14
.ChartTitle.Text = VBA.Strings.MonthName(VBA.DatePart("m", VBA.Date()) - 1) & " " & VBA.DatePart("yyyy", VBA.Date()) & _
" Test Title"
For Each srs In .SeriesCollection
For Each pt In srs.Points
pt.DataLabel.Text = "Y"
Next
Next
End With
On Error GoTo 0
Exit Sub
Form_Load_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Form_Load of VBA Document Form_testing"
End Sub
I'm able to change each label, but I can't seem to figure out a way to check each point in the series points.
EDIT: SOLVED (Simple, but works fine)
Sub AdjustDataLabels(cht As Chart)
Dim srs As Series
Dim pt As Point
Dim vals As Variant
For Each srs In cht.SeriesCollection
'Apply Value labels
srs.ApplyDataLabels (xlDataLabelsShowValue)
For Each pt In srs.Points
'Check for empty labels
If pt.DataLabel.Text = "" Then
'Do nothing
Else
'Add Series Name then remove Value
pt.DataLabel.ShowSeriesName = True
pt.DataLabel.ShowValue = False
End If
Next
Next
End Sub
Upvotes: 2
Views: 5910
Reputation: 41
SOLVED: (Simple, but works fine) Thanks for all the help!
Sub AdjustDataLabels(cht As Chart)
Dim srs As Series
Dim pt As Point
Dim vals As Variant
For Each srs In cht.SeriesCollection
'Apply Value labels
srs.ApplyDataLabels (xlDataLabelsShowValue)
For Each pt In srs.Points
'Check for empty labels
If pt.DataLabel.Text = "" Then
'Do nothing
Else
'Add Series Name then remove Value
pt.DataLabel.ShowSeriesName = True
pt.DataLabel.ShowValue = False
End If
Next
Next
End Sub
Upvotes: 2
Reputation: 53623
You are using a Graph.Chart
instead of a Chart
. They are more limited in what you can do with them, which is what I was afraid of. But perhaps this can help anyways.
The idea is to first ensure that the series data labels are being displayed.
Once we know they are displayed, iterate the points and selectively manipulate the point's DataLabel.Text
property, based on it's DataLabel.Text
property. I'm assuming the value here being displayed is 0
, and that you simply want to hide labels if it's 0
, and do nothing to the other labels.
Within your procedure we will call another sub to do this:
Set tstChart = [Forms]!testing!barEquip.Object
With tstChart
.HasTitle = True
.ChartTitle.Font.Size = 14
.ChartTitle.Text = VBA.Strings.MonthName(VBA.DatePart("m", VBA.Date()) - 1) & " " & VBA.DatePart("yyyy", VBA.Date()) & _
" Test Title"
Call AdjustDataLabels(tstChart) 'Call a procedure to modify the labels as needed
End With
So that code will now call on another sub-procedure:
Sub AdjustDataLabels(cht As Graph.Chart)
Dim srs As Graph.Series
Dim pt As Graph.Point
Dim vals As Variant
For Each srs In cht.SeriesCollection
'First, ensure the dataLabels are ON
srs.ApplyDataLabels
For Each pt In srs.Points
'Now, check the datalabels one by one, testing for your criteria
If pt.DataLabel.Text = " some condition " Then
'Criteria met, so blank out this datalabel
'pt.HasDataLabel = False
'OR:
pt.DataLabel.Text = vbNullString
Else
'If you need to make any adjustments to other labels,
' you can do that here.
' For example you could simply append the series name.
' Modify as needed.
pt.DataLabel.Text = pt.DataLabel.Text & " -- " & srs.Name
End If
Next
Next
End Sub
Upvotes: 2