Symulowanie "Słupków błędów" na wykresie.   strona główna:
A po co ten Excel ;-)
 
Osoby będące na bieżąco z Excelem pewnie nie odkryją niczego nowego w "Słupkach błędów" ale dla mnie, dysponującego wciąż  
wersją 2010 i ostatnio słabo zainteresowanego nowościami xl'owymi, to zupełna nowość.   support.office.com
Słupki błędów to wynalazek M$ dla wersji xl2013. Fajne to.. :-) i że nie da się zrobić w xl2010?? Można chociaż spróbować :-)   Dodawanie słupków błędów do wykresu
 
Naszą "bazą" będzie istniejący wykres kolumnowy. Ilość serii jak i punktów w serii - dowolna.  
Naszym zadaniem jest stworzenie linii symulujących "słupki błędów"  
Ich wartości określimy dowolną formułą wstawioną "obok" zakresu serii.
 
Innymi słowy. Sami określimy zakres naszego słupka błędu. Może to być  
dowolna wartość określona stałą lub formułą. Jak chcielibyśmy żeby wykres  
pokazywał np.: medianę a nasze słupki zakres kwartyli.. Nie ma problemu :-)  
Ważnym jest jednak żeby zakresy dla górnej i dolnej granicy słupków był  
równolegle do zakresu będącego źródłem serii: górna granica ponad, a   
dolna poniżej zakresu serii danych.  
 
Procedura realizująca takie zadanie może wyglądać następująco:  
 
 
Option Explicit  
 
Sub slupki_bledow()  
    Application.Calculate  
      
    Dim xlWks As Excel.Worksheet  
    Dim xlChr As Excel.Chart  
    Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
    Set xlChr = xlWks.ChartObjects(1).Chart  
      
    On Error Resume Next  
    xlChr.Lines.Delete  
    On Error GoTo 0  
 
    Dim xlSer As Excel.Series  
    Dim rngSer As Excel.Range  
    Dim xlPoint As Excel.Point  
      
    Set xlSer = xlChr.SeriesCollection(1)  
    Dim p1, p1H, p2, p2H  
    With xlSer  
        p1 = .Values(1): p1H = .Points(1).Top  
        p2 = xlChr.Axes(xlValue).MinimumScale: p2H = .Points(1).Height + .Points(1).Top  
    End With  
    Dim pXH: pXH = (p2H - p1H) / (p1 - p2)  
    Set xlSer = Nothing  
      
    Const grLinii As Single = 1.25  
    Dim colLinii As Long: colLinii = VBA.RGB(0, 0, 0)  
      
    Dim i As Integer, j As Integer  
    For j = 1 To xlChr.SeriesCollection.Count  
        Set xlSer = xlChr.SeriesCollection(j)  
        Set rngSer = Application.Range(Split(Replace(xlSer.Formula, "=SERIES(,,", ""), ",")(0))  
          
        For i = 1 To rngSer.Count  
            Set xlPoint = xlSer.Points(i)  
            Dim pp: pp = Application.Max(xlPoint.Top - (Abs(rngSer.Offset(-1).Cells(i) - xlSer.Values(i))) * pXH, _  
                                         0)  
              
            '--------------górna pionowa część-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        xlPoint.Top, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        pp)  
      
                .Line.Weight = grLinii  
                .Line.ForeColor.RGB = colLinii  
            End With  
            '--------------górny daszek-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            If pp > 0 Then  
                With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                            xlPoint.Left + xlPoint.Width / 2 - 5, _  
                            pp, _  
                            xlPoint.Left + xlPoint.Width / 2 + 5, _  
                            pp)  
          
                    .Line.Weight = grLinii  
                    .Line.ForeColor.RGB = colLinii  
                End With  
            End If  
            'Stop  
            pp = Application.Min(xlPoint.Top + (Abs(rngSer.Offset(1).Cells(i) - xlSer.Values(i))) * pXH, _  
                                 xlChr.PlotArea.Height)  
            '--------------dolna pionowa część-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        xlPoint.Top, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        pp)  
      
                .Line.Weight = grLinii  
                .Line.ForeColor.RGB = colLinii  
            End With  
            '--------------dolny daszek-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            If pp < xlChr.PlotArea.Height Then  
                With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                            xlPoint.Left + xlPoint.Width / 2 - 5, _  
                            pp, _  
                            xlPoint.Left + xlPoint.Width / 2 + 5, _  
                            pp)  
          
                    .Line.Weight = grLinii  
                    .Line.ForeColor.RGB = colLinii  
                End With  
            End If  
        Next  
        Set xlSer = Nothing  
        Set rngSer = Nothing  
    Next  
    Set xlWks = Nothing  
    Set xlChr = Nothing  
End Sub  
 
Fragmentami:  
 
    Application.Calculate  
 
Dane będące źródłem danych tworzące zarówno wykres jak i słupki określiłem za pomocą funkcji LOS(). Przeliczenie skoroszytu  
odświeży formuły i zakres danych do wykresu. Dalsza procedura stworzy słupki w odpowiednim miejscu.  
 
    Dim xlWks As Excel.Worksheet  
    Dim xlChr As Excel.Chart  
    Set xlWks = ThisWorkbook.Worksheets("Arkusz1")  
    Set xlChr = xlWks.ChartObjects(1).Chart  
 
Zadanie dotyczy pierwszego wykresu w Ark. Arkusz1.  
 
    On Error Resume Next  
    xlChr.Lines.Delete  
    On Error GoTo 0  
 
Słupki stworzę z linii. Przed stworzeniem nowego zestawu po przeliczeniu arkusza należy usunąć zestaw starych.  
 
    Set xlSer = xlChr.SeriesCollection(1)  
    Dim p1, p1H, p2, p2H  
    With xlSer  
        p1 = .Values(1): p1H = .Points(1).Top  
        p2 = xlChr.Axes(xlValue).MinimumScale: p2H = .Points(1).Height + .Points(1).Top  
    End With  
    Dim pXH: pXH = (p2H - p1H) / (p1 - p2)  
    Set xlSer = Nothing  
 
i cała magia :-)  Żeby określić poprawne miejsce na wykresie dla danej wartości należy wykorzystać dane o położeniu innych  
wartości będących już na wykresie. Jak to robię?? Sprawdzam wartość właściwości Top dowolnego punktu dowolnej serii. (np.:  
seria 1, punkt 1) i jego wartość. Drugim punktem jaki określam jest pozycja i wartość dla Minimum skali wykresu :-)  
Różnica pomiędzy wysokościami podzielona przez różnice pomiędzy wartościami punktów dadzą mi wysokość jednej jednostki na  
wykresie.  
 
    Const grLinii As Single = 1.25  
    Dim colLinii As Long: colLinii = VBA.RGB(0, 0, 0)  
 
Grubość i kolor linii słupka.  
 
    For j = 1 To xlChr.SeriesCollection.Count  
        Set xlSer = xlChr.SeriesCollection(j)  
        Set rngSer = Application.Range(Split(Replace(xlSer.Formula, "=SERIES(,,", ""), ",")(0))  
 
Dla każdej z serii tworzę zmienną obiektową xlSer i określam zakres będący jej "referencją". Zakresy nad i pod tym zakresem będą  
zawierać dane do wartości granic słupków.  
 
        For i = 1 To rngSer.Count  
            Set xlPoint = xlSer.Points(i)  
            Dim pp: pp = Application.Max(xlPoint.Top - (Abs(rngSer.Offset(-1).Cells(i) - xlSer.Values(i))) * pXH, _  
                                         0)  
 
Dla każdego punktu tworzę zmienną obiektową xlPoint i pozycję (wysokość) górnej granicy słupka. Jeżeli tak policzona wysokość  
jest ujemna to pp przyjmuje wartość 0. Oznacza to jedynie tyle że wartość punktu górnej granicy słupka wypada wyżej niż  
maximum skali jaką dobrał wykres. Można by określić stałą wartość tej granicy ale ja pozostawałem te wartość na "Automatyczną"  
Dlatego muszę przyjąć że granica słupka może być ponad wykresem.  
 
            '--------------górna pionowa część-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        xlPoint.Top, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        pp)  
      
                .Line.Weight = grLinii  
                .Line.ForeColor.RGB = colLinii  
            End With  
 
Tworzę słupek od wartości danego punktu do górnej granicy słupka. "xlPoint.Left + xlPoint.Width / 2" - to środek kolumny.  
 
            '--------------górny daszek-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            If pp > 0 Then  
                With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                            xlPoint.Left + xlPoint.Width / 2 - 5, _  
                            pp, _  
                            xlPoint.Left + xlPoint.Width / 2 + 5, _  
                            pp)  
          
                    .Line.Weight = grLinii  
                    .Line.ForeColor.RGB = colLinii  
                End With  
            End If  
 
Jeżeli górna granica wypada ponad wykresem to "daszek" nie będzie tworzony. Jak "się mieści"…  
 
            pp = Application.Min(xlPoint.Top + (Abs(rngSer.Offset(1).Cells(i) - xlSer.Values(i))) * pXH, _  
                                 xlChr.PlotArea.Height)  
 
Dolna część słupka.. Jeśli jednak wysokość tego punktu jest większa niż zakres kreślenia wykresu to oznacza że punkt wypada  
poniżej minimum skali.  
 
            '--------------dolna pionowa część-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        xlPoint.Top, _  
                        xlPoint.Left + xlPoint.Width / 2, _  
                        pp)  
      
                .Line.Weight = grLinii  
                .Line.ForeColor.RGB = colLinii  
            End With  
 
Dolna część słupka. Od wartości punktu do dolnej granicy słupka.  
 
            '--------------dolny daszek-------------  
                            '.AddConnector(Type, BeginX, BeginY, EndX, EndY)  
            If pp < xlChr.PlotArea.Height Then  
                With xlChr.Shapes.AddConnector(msoConnectorStraight, _  
                            xlPoint.Left + xlPoint.Width / 2 - 5, _  
                            pp, _  
                            xlPoint.Left + xlPoint.Width / 2 + 5, _  
                            pp)  
          
                    .Line.Weight = grLinii  
                    .Line.ForeColor.RGB = colLinii   przykład można pobrać
                End With   xlchr04.zip
            End If  
 
Jeżeli wysokość słupka nie wystaje poniżej wysokości zakresu kreślenia wykresu to tworzę dolny "daszek"  
i tyle :-)