Solved

Modifying DataLabel parameters in a series of charts

Posted on 2011-03-07
4
285 Views
Last Modified: 2012-06-22
How do I incorporate this routine into the main macro below so that it will apply the desired DataLabel configurations without targeting a specific chart?

In "getChartSourceData," I can leave the Separator parameter in the code and it doesn't bug, but if I comment out "Call FormatAutoLabels," it does nothing.

In "AlignDataLabelsSeries1" if I don't comment out the Separator parameter I get an 'Ovject doesn't support this property or method' error.  Ideally I'd like to be able to get line 33 working in "getChartSourceData"  with no selecting of charts at all. But if I could get it to work in "AlignDataLabelsSeries1,"   that would be just fine.
Thanks,
John

Sub FormatAutoLabels()
    ActiveSheet.Shapes("Chart_1").Select
    ActiveSheet.ChartObjects("Chart_1").Activate
    ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, _
        ShowSeriesName:=True, ShowValue:=True, Separator:="" & chr(10) & ""
    ActiveChart.SeriesCollection(2).ApplyDataLabels AutoText:=True, _
        ShowSeriesName:=True, ShowValue:=True, Separator:="" & chr(10) & ""
End Sub
Sub getChartSourceData()
Dim chr As ChartObject, rng1 As Range
For Each chr In ActiveSheet.ChartObjects
 Set rng1 = Intersect([ChartRange3], chr.TopLeftCell)
  If Not rng1 Is Nothing Then

    Dim Nm As String, rng2 As Range, xRng As Range, yRng As Range, z As Range, x As String, y As String
    Nm = chr.Name
    Set rng = [key]
    Set rng2 = [ChartNames]
    Set xRng = rng2.Find(What:=Nm, after:=rng, LookIn:=xlValues, LookAt _
            :=xlWhole).Offset(0, -2)
    Set yRng = xRng.Offset(0, 1)
    Set z = xRng.Offset(0, 3)
    x = xRng.Value
    y = yRng.Value
    
    xRng.Offset(0, -1).Activate
    
    If xRng.Offset(0, -1) = 0 Then
        chr.Delete
    Else
    
    On Error GoTo here

    
    chr.Chart.Legend.LegendEntries(1).LegendKey.Border.ColorIndex = 34
    chr.Chart.SeriesCollection(1).XValues = "='Week Summary'!R" & x & "C3:R" & y & "C3"
    chr.Chart.SeriesCollection(1).values = "='Week Summary'!R" & x & "C5:R" & y & "C5"
    chr.Chart.SeriesCollection(2).XValues = "='Week Summary'!R" & x & "C3:R" & y & "C3"
    chr.Chart.SeriesCollection(2).values = "='Week Summary'!R" & x & "C7:R" & y & "C7"
    chr.Chart.ChartTitle.Characters.Text = z
    chr.Chart.SeriesCollection(1).ApplyDataLabels AutoText:=True, _
        ShowSeriesName:=True, ShowValue:=True, Separator:="" & chr(10) & ""
    End If
  End If
Next
here:
Call FormatAutoLabels
Range("A1").Activate
End Sub

*********************************************
Sub FormatAutoLabels()
    ActiveSheet.Shapes("Chart_1").Select
    ActiveSheet.ChartObjects("Chart_1").Activate
    ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, _
        ShowSeriesName:=True, ShowValue:=True, Separator:="" & chr(10) & ""
    ActiveChart.SeriesCollection(2).ApplyDataLabels AutoText:=True, _
        ShowSeriesName:=True, ShowValue:=True, Separator:="" & chr(10) & ""
    Range("A1").Select
End Sub

**********************************************
Sub AlignDataLabelsSeries1()
Application.ScreenUpdating = False
Dim chr As ChartObject, rng1 As Range
For Each chr In ActiveSheet.ChartObjects
Set rng1 = Intersect([ChartRange3], chr.TopLeftCell)
  If Not rng1 Is Nothing Then
    Dim str As String
        If ActiveSheet.Shapes(Application.Caller).TopLeftCell = "" Then
        str = 2
        Else
        str = ActiveSheet.Shapes(Application.Caller).TopLeftCell
        End If
    ActiveSheet.ChartObjects("ChartFormat" & str).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy

    chr.Activate
    ActiveChart.Paste Type:=xlFormats
    
           
    Dim pt As Points
    Set pt = ActiveChart.SeriesCollection(1).Points
    For ix = 1 To pt.Count
      If str <> 4 Then
        If pt.Count <= 7 Then
       
        ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, _
        ShowSeriesName:=True, ShowValue:=True ', Separator:="" & chr(10) & ""
        pt.Item(ix).DataLabel.Position = xlLabelPositionInsideEnd
        pt.Item(ix).DataLabel.Font.Size = 8
        pt.Item(ix).DataLabel.Font.Italic = True
        pt.Item(ix).DataLabel.Font.Bold = True
        pt.Item(ix).DataLabel.Font.ColorIndex = 2
          If str = 2 Then
          pt.Item(ix).DataLabel.Font.ColorIndex = 14
          End If
            
        End If
        Else
        GoTo here
      End If
    Next
  End If
Next
Range("A1").Select
Call AlignDataLabelsSeries2
here:
Call GetChartTitles
Call getChartSourceData
Application.ScreenUpdating = True
End Sub

Open in new window

0
Comment
Question by:gabrielPennyback
  • 2
  • 2
4 Comments
 
LVL 18

Accepted Solution

by:
krishnakrkc earned 500 total points
ID: 35064213
Hi,

May be..


and call the peocedure as FormatAutoLabels chr

Kris
Sub FormatAutoLabels(ByRef ChartObj As ChartObject)
    
    Dim chtChart    As Chart
    
    Set chtChart = ChartObj.Chart
    
    With chtChart
        .SeriesCollection(1).ApplyDataLabels AutoText:=True, _
            ShowSeriesName:=True, ShowValue:=True, Separator:="" & Chr(10) & ""
        .SeriesCollection(2).ApplyDataLabels AutoText:=True, _
            ShowSeriesName:=True, ShowValue:=True, Separator:="" & Chr(10) & ""
    End With
End Sub

Open in new window

0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 35090371
Hi krishnakrkc, thanks. Could you please incorporate your code into one of my pieces of code? I can't figure out how to use it.    -  Thanks, John
0
 
LVL 1

Author Closing Comment

by:gabrielPennyback
ID: 35101525
Thanks.
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 35105019
Hi John,

I already stated this in my post.

replace

Call FormatAutoLabels

with

FormatAutoLabels chr

where chr is the variable name for chartobject

0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now