poniedziałek, 20 marca 2017

ExcelVBA: From recorded macro to reusable function.

Problem: with each change in slicer, pivot chart formatting changes.
 
So I want all my lables vertical (and with each change the damn thing returns to horizontal). My recorded macro did not return anything sensible. Lecture on chart label properties brought me to this solution:

Sub Macro1()
'
' Wersja "Recorder"
'
Dim mySrs As Series

With ActiveSheet.ChartObjects("chValueofOffers").Chart
        

    .SeriesCollection(1).DataLabels.Orientation = xlUpward
    .SeriesCollection(2).DataLabels.Orientation = xlUpward


End With



Next I wanted to iterate through series collection so that I do not need to change macro for more series:

Sub Macro2()
'
' Wersja "Obiektowo pętlowa"

'

Set seriesCol = ActiveSheet.ChartObjects("chValueofOffers").Chart.SeriesCollection
        
For Each mySeries In seriesCol
    mySeries.DataLabels.Orientation = xlUpward
Next

Set seriesCol = ActiveSheet.ChartObjects("chValueofOffersTotal").Chart.SeriesCollection


   
End Sub

 Finally... what if I have several charts on the same sheet that need vertical labels. Why not making it a reusable function with chart name as attribute. Now... with each change in the slicer the labels in the two charts get corrected to vertical.


Private Function DataLabelsVertical(mySheet As String, chtName As String)

 Dim mySeries As Series
 Set seriesCol = Worksheets(mySheet).ChartObjects(chtName).Chart.SeriesCollection

    For Each mySeries In seriesCol
       mySeries.DataLabels.Orientation = xlUpward
    Next

End Function

Private Sub Worksheet_Change(ByVal Target As Range)
   DataLabelsVertical "Value_tenders", "chValueofOffers"
   DataLabelsVertical "Value_tenders", "chValueofOffersTotal"
   DataLabelsVertical "Status", "chStatusValue"
   DataLabelsVertical "Status", "chStatusValueTotal"
End Sub


End Function


 Sources:
http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/Loopthrougheachseriesinchartandaltermarkercolors.htm
http://stackoverflow.com/questions/21165581/vba-looping-through-all-series-within-all-charts



Brak komentarzy:

Prześlij komentarz