Example The DoData Labels Procedure

Sub DoDataLabels() Dim i As Integer Dim rngLabels As Range Dim fnt As Font

' Is a data series selected? Get its size. If lstSeries.ListIndex = -1 Then

MsgBox "You must select a data series.",

Exit Sub Else

Set DataSeries = oChart.SeriesCollection

' There will be an error if the chart does not support data points

On Error Resume Next cPoints = DataSeries.Points.Count

MsgBox "Charts of the selected type do not support data labels.", vbCritical Unload Me Exit Sub End If End If vbInformation

(lstSeries.ListIndex +

' Get the labels range

Set rngLabels = Range(reditLabels.Value) If rngLabels Is Nothing Then

MsgBox "You must select a range of cells equal in number to " &

"the number of data points in the series.", vbInformation Exit Sub End If

' Check counts

If cPoints <> rngLabels.Count Then

MsgBox "The number of label cells (" & rngLabels.Count &

") does not equal the number of data points (" & cPoints & _ ") in the selected series.", vbInformation Exit Sub End If

' Check for existing labels If DataSeries.HasDataLabels ' Dimension the array ReDim LabelsForUndo(1 To

LabelsForUndo(i).HasDataLabel = DataSeries.Points(i).HasDataLabel

If LabelsForUndo(i).HasDataLabel Then ' Save the label text LabelsForUndo(i).Label = DataSeries.Points(i).DataLabel.Text

' Save the formatting

With DataSeries.Points(i).DataLabel.Font LabelsForUndo(i).FontName = .Name LabelsForUndo(i).FontSize = .Size LabelsForUndo(i).Color = .Color LabelsForUndo(i).Bold = .Bold LabelsForUndo(i).Italic = .Italic End With End If Next cmdUndo.Enabled = True End If

' Now do data labels based on options If optLink Then

For i = 1 To cPoints

DataSeries.Points(i).HasDataLabel = True DataSeries.Points(i).DataLabel.Text = "=" & rngLabels.Parent.Name

& "!" & rngLabels.Cells(i).Address(ReferenceStyle:=xlR1C1)

If chkOption Then

' Set number format link

DataSeries.Points(i).DataLabel.NumberFormatLinked = True End If Next Else

For i = 1 To cPoints and save them Then cPoints)

DataSeries.Points(i).HasDataLabel = True DataSeries.Points(i).DataLabel.Text = rngLabels.Cells(i).Value

If chkOption Then bCopyFormatting = True

With DataSeries.Points(i).DataLabel.Font .Name = rngLabels.Cells(i).Font.Name .Size = rngLabels.Cells(i).Font.Size .Bold = rngLabels.Cells(i).Font.Bold .Italic = rngLabels.Cells(i).Font.Italic .Color = rngLabels.Cells(i).Font.Color End With

DataSeries.Points(i).DataLabel.NumberFormat = rngLabels.Cells(i).NumberFormat

Else bCopyFormatting = False End If Next End If End Sub

The Undo command button's Click event, which is shown in Example 21-16, restores the original data labels that are saved in the DoDataLabels procedure.

0 0

Post a comment