Automatisch eerste en laatste chart point labellen

Djani · 10 mei 2016

Hoi allemaal,

Op dit moment ben ik bezig met het automatiseren van de grafieken, maar hierbij moet ik iedere eerste en laatste labelpoint vermelden en de merken een bepaalde kleur toekennen.
Ik weet echter niet goed hoe ik dit voor elkaar krijg. Ik heb wat op het internet rondgekeken, en ben onderstaande sites tegengekomen:

http://datapigtechnologies.com/blog/index.php/automatically-label-first-and-last-chart-points/
http://peltiertech.com/Excel/Charts/LabelLastPoint.html

Alsnog ben ik niet veel verder gekomen!

Wat betreft de kleuren die gebruikt zullen worden, de kleurcodes heb ik naast de tabel geplaatst van de rapportage die in de bijlage staat.

In de sheet zie je een plaatje van een grafiek in de gewenste situatie welke de juiste kleurcodes en eerste/laatste datalabel bevat. Ik weet overigens ook niet hoe ik de grafiek precies zulke vloeiende lijnen laat weergeven.

Kunnen jullie mij verderhelpen?

Bij voorbaat dank,

Djani

Bekijk bijlage GRAPH vb.xlsx

HSV · 10 mei 2016

De labels liggen zo dicht op elkaar dat het niet meer te lezen is, maar goed bekijk het maar eens.

Code:

Sub hsv()
Dim sn, i As Long, j As Long, x As Long
With Sheets("brand tpva ppt")
  .ChartObjects("Object 3").Chart.ApplyDataLabels (-4142)
sn = .Range("L6:W13")
 For i = 1 To UBound(sn)
  For j = 1 To 2
   x = IIf(j = 1, LBound(sn, 2), UBound(sn, 2))
    With .ChartObjects("Object 3").Chart.SeriesCollection(i).Points(x)
        .HasDataLabel = True
        .DataLabel.Text = Round(sn(i, x), 1)
    End With
  Next j
 Next i
End With
End Sub

Djani · 12 mei 2016

Hoi HSV,

Excuses voor mijn late reactie. De macro werkt gewoon prima, dus ontzettend bedankt. Is er een mogelijkheid om de lettertype en de grootte ervan te veranderen --> van "verdana 18,8" naar "verdana "10,0"?

Mvg,

Djani

HSV · 12 mei 2016

De lettergrootte alleen dus.

Code:

Sub hsv()
Dim sn, i As Long, j As Long, x As Long
With Sheets("brand tpva ppt")
  .ChartObjects("Object 3").Chart.ApplyDataLabels (-4142)
sn = .Range("L6:W13")
 For i = 1 To UBound(sn)
  For j = 1 To 2
   x = IIf(j = 1, LBound(sn, 2), UBound(sn, 2))
    With .ChartObjects("Object 3").Chart.SeriesCollection(i).Points(x)
        .HasDataLabel = True
        .DataLabel.Text = Round(sn(i, x), 1)
[COLOR=#3333ff]        .DataLabel.Font.Size = 10[/COLOR]
    End With
  Next j
 Next i
End With
End Sub

Djani · 13 mei 2016

Thanks HSV.

Van de script heb ik alleen de sheetnaam en de objectnaam veranderd, maar dan krijg ik een foutmelding bij de code die ik in het rood heb gemarkeerd:

Code:

Sub hsv()
Dim sn, i As Long, j As Long, x As Long
With Sheets("4. GPR per country")
  .ChartObjects("Chart 2").Chart.ApplyDataLabels (-4142)
sn = .Range("L6:W14")
 For i = 1 To UBound(sn)
  For j = 1 To 2
   x = IIf(j = 1, LBound(sn, 2), UBound(sn, 2))
    With .ChartObjects("Object 3").Chart.SeriesCollection(i).Points(x)
        .HasDataLabel = True
        [COLOR="#FF0000"].DataLabel.Text = Round(sn(i, x), 1)[/COLOR]
        .DataLabel.Font.Size = 10
    End With
  Next j
 Next i
End With
End Sub

De foutmelding is "Type mismatch". Ik denk te weten waar het vandaan komt. In de tabel, waarnaar verwezen wordt, komt #N/A voor. Zou dit het kunnen zijn? Kan de macro hier omheen werken?

HSV · 13 mei 2016

Test het zo maar eens.

Code:

Sub hsv()
Dim sn, i As Long, j As Long, x As Long
With Sheets("brand tpva ppt")
  .ChartObjects("Object 3").Chart.ApplyDataLabels (-4142)
sn = .Range("L6:W13")
 For i = 1 To UBound(sn)
  For j = 1 To 2
   x = IIf(j = 1, LBound(sn, 2), UBound(sn, 2))
 [COLOR="#0000FF"]  If Not IsError(sn(i, x)) Then[/COLOR]
    With .ChartObjects("Object 3").Chart.SeriesCollection(i).Points(x)
        .HasDataLabel = True
        .DataLabel.Text = Round(sn(i, x), 1)
        .DataLabel.Font.Size = 10
    End With
   [COLOR="#0000FF"]end if[/COLOR]
  Next j
 Next i
End With
End Sub

Djani · 17 mei 2016

Goedemorgen HSV,

Macro werkt perfect, maar hij labelt de laatste chart points alleen als de laatste kolom van de range - waarnaar verwezen wordt - data bevat.
In dit geval moest ik de range veranderen van "L6:W13" naar "L6:T13". Kan de macro dit automatisch doen of moet dit maandelijks aangepast worden in VBA zelf?

Ik heb voor de zekerheid een voorbeeld in de bijlage gezet met jouw macro daarin.

Thanks voor je hulp!

HSV · 17 mei 2016

Het kan dus ook voorkomen dat er een #N/B zoals in L13 staat?
Ik wil dit even zeker weten, en wat er dan moet gebeuren.

De cellen M6:T14 staan daar normaal ook formules of alleen maar waarden zoals nu?

VenA · 17 mei 2016

Een bestandje met koppelingen naar andere bestand(en) is niet echt handig. Waarschijnlijk kan je met draaitabellen en daaraan gekoppelde grafieken hetzelfde resultaat bereiken.

Als ik de vraag goed begrepen heb dan kan je het bereik van de array sn aanpassen in

Code:

sn = .[L6].Resize(9, .[L6].End(xlToRight).Column - 11)

Maar als HSV al een paar ?? heeft schiet ik mogelijk de plank mis. Data die je niet hebt moet je eigenlijk niet willen tonen in een grafiek. (Dit is een persoonlijk smaak)

Djani · 18 mei 2016

@HSV, inderdaad. In de tabel zullen/kunnen #N/A voorkomen, omdat de data van de toekomstige maanden nog niet beschikbaar is. Ik zou de macro de laatste maand met 'beschikbare data' willen laten labelen indien mogelijk.

Wat betreft de tabel: deze bevatten simpele VLOOKUP functies en verwijzen naar een ander tabblad, maar de structuur van de tabel zal nooit en te nimmer veranderen.

@VenA, je hebt ook helemaal gelijk. Ik heb expres de data als #N/A gezet, omdat ik deze data niet in de grafiek wil laten opnemen, tenzij er echte data in zit natuurlijk!

HSV · 18 mei 2016

Bekijk het maar eens Djani.

De gegevens komen in dit geval uit blad1 (om te testen).

Djani · 19 mei 2016

@HSV, je bent een held. Zou jij mij misschien uit kunnen leggen wat voor logica je hebt toegepast (en waar je allemaal rekening mee hebt moeten houden)?

Momenteel heb ik 5x een kopie van jouw macro gemaakt, waarbij ik zelf de range en de chartnaam heb gewijzigd:
- "Chart 2" gebruikt range "L19:W27";
- "Chart 3" gebruikt range "L32:W40";

Zou het ook mogelijk zijn om hierin een loop te verwerken?

Djani · 19 mei 2016

@HSV, Ik wist dit ook niet op voorhand, maar er zijn tabellen - dezelfde structuur qua kolommen/rijen - waarvan een bepaalde rij geen data bevat. Dit wordt aangeduid met alleen de term "vs". De termen van de overige rijen bevatten de combinatie "vs" & "model". Ik kan die rij niet verwijderen om de macro te laten werken, want volgend jaar kan hier bijv. een concurrent komen te staan.

Ik heb de rapportage in de bijlage gezet met jouw macro.

Bekijk bijlage HSV.xlsm

HSV · 19 mei 2016

Ik zet net de Pc aan en heb het voor je drie grafieken net klaar.

Aangepast in het rood op basis van #13 _ 17:46 uur.

Code:

Option Explicit
Sub hsv()
Dim co As Long, sn, i As Long, j As Long, jj As Long, a As Long, b As Long, y As Long
With Sheets("Brand TPVA G5 Countries")
For co = 1 To 3
 .ChartObjects(co).Chart.ApplyDataLabels (-4142)
  sn = .Range("L6:W14").Offset(co * 13 - 13)
For i = 1 To UBound(sn)
  For j = 1 To 2
   For jj = 1 To UBound(sn, 2)
       If Not IsError(sn(i, jj)) And j = 1 Then
           a = jj
           b = a
           Exit For
       ElseIf j = 1 Then y = jj + a
       ElseIf Not IsError(sn(i, jj)) And j = 2 Then
           a = a + 1
       End If
     If b < a + y Then b = a + y
    Next jj
    With .ChartObjects(co).Chart.SeriesCollection(i).Points(b)
  [COLOR="#FF0000"]   if not iserror(sn(i,b)) then[/COLOR]
        .HasDataLabel = True
        .DataLabel.Text = Round(sn(i, b), 1)
        .DataLabel.Font.Size = 10
     [COLOR="#FF0000"]end if[/COLOR]
    End With
        b = 0
        a = 0
     Next j
       y = 0
   Next i
 Next co
End With
End Sub

Djani · 20 mei 2016

Je bent opnieuw een held. Thanks man!

Zou je mij alsnog kunnen uitleggen wat voor logica je hebt toegepast? Ik begrijp hem zelf niet helemaal namelijk.

HSV · 20 mei 2016

Zet onderstaande code maar eens in de module, en zie dan de groene tekst die verschijnt.

Code:

Sub hsv()
Dim co As Long, sn, i As Long, j As Long, jj As Long, a As Long, b As Long, y As Long 'declareren van variabelen
With Sheets("Brand TPVA G5 Countries")  'van toepassing op dit blad
For co = 1 To 3  'maak een loop van grafiek 1 tot 3
 .ChartObjects(co).Chart.ApplyDataLabels (-4142)  'verwijder alle datalabels
  sn = .Range("L6:W14").Offset(co * 13 - 13)   'bepalen van de range
For i = 1 To UBound(sn)  ' van 1 tot het einde van de range (van boven naar beneden).
  For j = 1 To 2  'van 1 tot 2  (om de eerste en laatste positie te bepalen in de breedte van de range (per rij dus).
   For jj = 1 To UBound(sn, 2)  'van 1 tot de laatste cel per rij in de breedte
       If Not IsError(sn(i, jj)) And j = 1 Then    'als de cel geen fout bevat en J = 1 dan
           a = jj
           b = a
           Exit For
       ElseIf j = 1 Then y = jj + a      'als anders, dan
       ElseIf Not IsError(sn(i, jj)) And j = 2 Then  'als anders, dan
           a = a + 1
       End If
     If b < a + y Then b = a + y
    Next jj
    With .ChartObjects(co).Chart.SeriesCollection(i).Points(b)  ' voor grafiek 1, 2, of 3, grafieklijn van loop i, en grafiekpunt waarde b.
     if not iserror(sn(i,b)) then  'als er helemaal geen foute cellen zijn dan.
        .HasDataLabel = True   'maak een datalabel
        .DataLabel.Text = Round(sn(i, b), 1)   'zet het getal in de datalabel
        .DataLabel.Font.Size = 10    
     end if
    End With
        b = 0   'zet b op nul
        a = 0   '  ,, a      ,,
     Next j
       y = 0
   Next i
 Next co   'volgend grafiek
End With
End Sub

Djani · 23 mei 2016

Thanks topper, bedankt voor alle hulp. Ik markeer de thread als opgelost!

Djani · 26 jul 2016

Heren,

Sorry dat ik de thread weer tot leven breng, maar ik heb een vraag over de macro (die overigens nog steeds prima werkt). Alsnog bedankt daarvoor.

Op dit moment is de macro gebouwd voor een tabel met 9 rijen. Echter, als ik bijv. de tabel wil vergroten door er 1 extra rij bij toe te voegen, dan pakt die hem niet meer.
Ik heb de range van de macro correct aangepast, maar die geeft de foutmelding "Type mismatch" bij het stukje code:

Code:

.DataLabel.Text = Round(sn(i, b), 1) 'Put the TPVA number in the datalabel

Zou iemand van jullie mij uit kunnen leggen wat er precies fout gaat en hoe ik deze evt aangepast kan krijgen?

Ik heb in de bijlage een voorbeeld gestopt met daarin 2 tabellen, 2 grafieken en de macro!

Bekijk bijlage vb.xlsm

HSV · 26 jul 2016

Mitsubishi ontbreekt in je reeks.

Djani · 27 jul 2016

Is wel zo logisch inderdaad. Ik heb Mitsubishi bij de grafiek toegevoegd, maar alsnog krijg ik de foutmelding "type mismatch"?

Qua ontbrekende data of reeksen kan het denk ik nu niet liggen. Enig idee?

Heb voor de zekerheid het bijgewerkte bestand in de bijlage gestopt.

Bekijk bijlage vb1.xlsm

Alvast ontzettend bedankt!

Automatisch eerste en laatste chart point labellen

Gebruiker

Inventaris

Bijlagen

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Bijlagen

Inventaris

Inventaris

Gebruiker

Inventaris

Bijlagen

Gebruiker

Gebruiker

Inventaris

Gebruiker

Inventaris

Gebruiker

Gebruiker

Inventaris

Gebruiker

Wij waarderen jouw privacy