Solved

Modifying DataLabel parameters in a series of charts

Posted on 2011-03-07
4
284 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
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks.
0
 
LVL 18

Expert Comment

by:krishnakrkc
Comment Utility
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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

744 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

15 Experts available now in Live!

Get 1:1 Help Now