user3664452
user3664452

Reputation: 133

Macro adding line on pivot chart/origin position in pivot chart

Excel 2007, VB 6.3

I created a pivot chart (chart from pivot table) type xlCylinderColStacked. Axis y scale: minimum 0%, maximum 2%. I would like to add a horizontal line at a target level of 0.7% (target is not fixed, but should be taken from another cell in another sheet: Target = Sheets("equivalenti").Range("N6").Value) Command should be something like

 .Shapes.AddLine(60, vertical_position, 940, vertical_position).Line

I tried to create a formula to calculate vertical_position given .Axes(xlValue).MaximumScale, .Axes(xlValue).MinimumScale, .ChartArea.Top, .PlotArea.Height but I can't find a solution. Any idea?

Basically, it would be easy to place the horizontal line if I knew exact position of the origin (0% on axis y) from the top-left corner which is taken as a reference for the .top and .left measures on the ChartArea.

I report below full code for two out of fours charts (correction is 8 in one case and 27 in another -- I only care vertical position)

        Sub Macro2()

        With Sheets("conveyor_mese")
            .Select

            .Cells.Select

        End With
        Selection.delete Shift:=xlUp
        Range("A1").Select
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "dati!R1C1:R9999C28", Version:=xlPivotTableVersion12).CreatePivotTable _
            TableDestination:="conveyor_mese!R1C1", TableName:= _
            "Tabella_pivot1", DefaultVersion:=xlPivotTableVersion12
        ActiveSheet.Shapes.AddChart.Select
        With ActiveChart
            .SetSourceData Source:=Range("conveyor_mese!$A$1:$C$28")
            .ChartType = xlCylinderColStacked
             .Legend.Position = xlBottom
            .Rotation = 0
            .Elevation = 0
            .Perspective = 10
        End With
        With ActiveSheet.PivotTables("Tabella_pivot1").PivotFields("Anno")
             .Orientation = xlRowField
             .Position = 1
        End With
        With ActiveSheet.PivotTables("Tabella_pivot1").PivotFields("Mese")
             .Orientation = xlRowField
             .Position = 2
        End With
        With ActiveSheet.PivotTables("Tabella_pivot1").PivotFields("anno")
            .PivotItems("(blank)").Visible = False
        End With
        With Worksheets("conveyor_mese")
            .ChartObjects(1).Top = .Rows("25").Top
            .ChartObjects(1).Left = .Columns("B").Left
            .ChartObjects(1).Height = 500
            .ChartObjects(1).Width = 330

        End With
        ActiveWorkbook.ShowPivotChartActiveFields = False
        With ActiveSheet.PivotTables("Tabella_pivot1").CalculatedFields
            .Add "% SCARTO BUCHI", "='Somma di  BUCHI'/'prod. Giorno'", True
            .Add "% SCARTO VENATURE", "='Somma di  VENATURE' /'prod. Giorno'", True
            .Add "% SCARTO BASSE", "='Somma di LASTRE BASSE' /'prod. Giorno'", True
            .Add "% CAUSA FOAM", "='SCARTI CONVEYOR'/'prod. Giorno'", True
            .Add "% CAUSA TAGLIO", "='SCARTI TAGLIO'/'prod. Giorno'", True
            .Add "% TOTALE SCARTI", "='TOTALE SCARTI'/'prod. Giorno'", True
            .Add "% SCARTO BORDO LATERALE", "='Somma di BORDO LATERALE' /'prod. Giorno'", True
            .Add "% SCARTO FORCHE", "='Somma di FORCHE MULETTO'/'prod. Giorno'", True
            .Add "% SCARTO CREPE", "='Somma di  CREPE' /'prod. Giorno'", True
            .Add "% CROSTE LATERALI", "='Somma di  CROSTE LATERALI' /'prod. Giorno'", True
            .Add "% ALTRO", "='Conteggio di ALTRI DIFETTI'/'prod. Giorno'", True
            .Add "% SCARTO ROTTURE MECC. FILO", "='Somma di ROTTURE MECCANICHE FILO' /'prod. Giorno'", True
            .Add "% SCARTO ROTTURE MECC. PONTE CARICO", "='Somma di ROTTURE MECCANICHE PONTE CARICO' /'prod. Giorno'", True
            .Add "% SCARTO ROTTURE MECC. SQUADRATRICI", "='Somma di ROTTURE MECCANICHE SQUADRATRICI' /'prod. Giorno'", True
            .Add "% SCARTO RIGHE NON PARALLELE", "='Somma di RIGHE NON PARALLELE' /'prod. Giorno'", True
            .Add "% CROSTE SUPERFICIALI", "='Somma di  CROSTE SUPERFICIALI' /'prod. Giorno'", True
            .Add "% SCARTO CORTE", "='Somma di LASTRE CORTE' /'prod. Giorno'", True
        End With
        With ActiveSheet.PivotTables("Tabella_pivot1")
            .PivotFields("% SCARTO BUCHI").Orientation = xlDataField

            .PivotFields("% CROSTE LATERALI").Orientation = xlDataField
            .PivotFields("% SCARTO CREPE").Orientation = xlDataField
            .PivotFields("% SCARTO BORDO LATERALE").Orientation = xlDataField
            .PivotFields("% SCARTO VENATURE").Orientation = xlDataField
            .PivotFields("% CROSTE SUPERFICIALI").Orientation = xlDataField
        End With
        Set pvtTable = ActiveSheet.PivotTables("Tabella_pivot1")
        For Each pvtField In pvtTable.DataFields

            pvtField.NumberFormat = "0.00%"
        Next pvtField
        Worksheets("conveyor_mese").ChartObjects(1).Activate

        With ActiveChart
            .PlotArea.Select

            Selection.Height = 350
            Selection.Top = 125
            .SetElement (msoElementDataLabelShow)

            .SetElement (msoElementChartTitleAboveChart)

            With .ChartTitle
                .Text = _
                    "REPARTO TAGLIO - IMPIANTO DI TAGLIO LINEA BASSA DENSITA'" & Chr(13) & "Dettaglio delle cause di scarto lastre per DIFETTO SCHIUMA - " & Chr(13) & "Mensile  "
                .HorizontalAlignment = xlCenter
            End With
            With .Axes(xlValue)
                 .MajorUnit = 0.002
                .MaximumScale = 0.015
                .MinimumScale = 0
            End With
            With .Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 80, 300, 130)
                  With .TextFrame
                    .Characters.Text = "Venature : striature superficiali con sciami di bolle" & vbLf & _
                       "Buchi : bolle o buchi superficiali con diametro superiore a 3 mm e numerosità >3 per lastra " & vbLf & _
                       "Crepe : crepe e stracciature prevalentemente laterali formatesi durante la schiumatura" & vbLf & _
                       "Bordo laterale : struttura cellulare molto orientata con colore e consistenza non adeguata" & vbLf & _
                       "Croste laterali : presenza di croste sul bordo laterale riconducibili ad un profilo inadeguato  del blocco grezzo."
                    .Characters(1, 7).Font.Bold = True
                     .Characters(54, 7).Font.Bold = True
                    .Characters(146, 7).Font.Bold = True
                    .Characters(234, 16).Font.Bold = True
                    .Characters(325, 17).Font.Bold = True
                 End With
                 .Fill.ForeColor.RGB = RGB(255, 255, 255)
                 With .Line
                    .Weight = 0.75
                    .ForeColor.RGB = RGB(191, 191, 191)
                 End With
            End With
            Target_s = Sheets("equivalenti").Range("N6").Value
            With .Shapes.AddTextbox(msoTextOrientationHorizontal, 670, 270, 130, 16)
               With .TextFrame.Characters
                    .Text = "Obiettivo " & Sheets("equivalenti").Range("N5").Value & "     " & Format(Target_s, "Percent")
                    .Font.Color = RGB(255, 255, 255)
                End With
                .Fill.ForeColor.RGB = RGB(192, 80, 77)
            End With
            X = .ChartArea.Left + ActiveChart.PlotArea.InsideLeft
            Y = .ChartArea.Top + ActiveChart.PlotArea.InsideTop + 8
            x1 = X + ActiveChart.PlotArea.InsideWidth
            step = ActiveChart.Axes(xlValue).Height / (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale)
            y1 = step * (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale - (Target_s - ActiveChart.Axes(xlValue).MinimumScale))
              With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, X, Y + y1, x1, Y + y1)
                .Select
                .Line.ForeColor.RGB = RGB(192, 80, 77)
                .Line.DashStyle = msoLineSolid
                 .Line.Weight = 2.75
             End With
            NameLine = Selection.Name
            .GapDepth = 50
            .ChartGroups(1).GapWidth = 50
        End With
        '********************************************************************************************************
        '********************************************************************************************************
        '********************************************************************************************************
        Sheets("taglio_mese").Select
        Sheets("taglio_mese").Cells.Select
        Selection.delete Shift:=xlUp
        Range("A1").Select
        ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
            "dati!R1C1:R9999C28", Version:=xlPivotTableVersion12).CreatePivotTable _
            TableDestination:="taglio_mese!R1C1", TableName:= _
            "Tabella_pivot5", DefaultVersion:=xlPivotTableVersion12
        ActiveSheet.Shapes.AddChart.Select
        With ActiveChart
            .SetSourceData Source:=Range("'taglio_mese'!$A$1:$C$28")
            .ChartType = xlCylinderColStacked
            .Legend.Position = xlTop
            .Rotation = 0
            .Elevation = 0
            .Perspective = 10
        End With
        With ActiveSheet.PivotTables("Tabella_pivot5").PivotFields("ANNO")
            .Orientation = xlRowField
            .Position = 1
        End With
        With ActiveSheet.PivotTables("Tabella_pivot5").PivotFields("MESE")
            .Orientation = xlRowField
            .Position = 2
        End With
        With Worksheets("taglio_mese")
            .ChartObjects(1).Top = .Rows("25").Top
            .ChartObjects(1).Left = .Columns("B").Left
            .ChartObjects(1).Height = 1100
            .ChartObjects(1).Width = 500
        End With
        ActiveWorkbook.ShowPivotChartActiveFields = False
            With ActiveSheet.PivotTables("Tabella_pivot5").PivotFields("mese")
                .PivotItems("(blank)").Visible = False
            End With
        With ActiveSheet.PivotTables("Tabella_pivot5").CalculatedFields
            .Add "% SCARTO BUCHI", "='Somma di  BUCHI'/'prod. Giorno'", True
            .Add "% SCARTO VENATURE", "='Somma di  VENATURE' /'prod. Giorno'", True
            .Add "% SCARTO BASSE", "='Somma di LASTRE BASSE' /'prod. Giorno'", True
            .Add "% CAUSA FOAM", "='SCARTI CONVEYOR'/'prod. Giorno'", True
            .Add "% CAUSA TAGLIO", "='SCARTI TAGLIO'/'prod. Giorno'", True
            .Add "% TOTALE SCARTI", "='TOTALE SCARTI'/'prod. Giorno'", True
            .Add "% SCARTO BORDO LATERALE", "='Somma di BORDO LATERALE' /'prod. Giorno'", True
            .Add "% SCARTO FORCHE", "='Somma di FORCHE MULETTO'/'prod. Giorno'", True
            .Add "% SCARTO CREPE", "='Somma di  CREPE' /'prod. Giorno'", True
            .Add "% CROSTE LATERALI", "='Somma di  CROSTE LATERALI' /'prod. Giorno'", True
            .Add "% ALTRO", "='Conteggio di ALTRI DIFETTI'/'prod. Giorno'", True
            .Add "% SCARTO ROTTURE MECC. FILO", "='Somma di ROTTURE MECCANICHE FILO' /'prod. Giorno'", True
            .Add "% SCARTO ROTTURE MECC. PONTE CARICO", "='Somma di ROTTURE MECCANICHE PONTE CARICO' /'prod. Giorno'", True
            .Add "% SCARTO ROTTURE MECC. SQUADRATRICI", "='Somma di ROTTURE MECCANICHE SQUADRATRICI' /'prod. Giorno'", True
            .Add "% SCARTO RIGHE NON PARALLELE", "='Somma di RIGHE NON PARALLELE' /'prod. Giorno'", True
            .Add "% CROSTE SUPERFICIALI", "='Somma di  CROSTE SUPERFICIALI' /'prod. Giorno'", True
            .Add "% SCARTO CORTE", "='Somma di LASTRE CORTE' /'prod. Giorno'", True
        End With
        With ActiveSheet.PivotTables("Tabella_pivot5")
            .PivotFields("% SCARTO BASSE").Orientation = xlDataField
            .PivotFields("% SCARTO FORCHE").Orientation = xlDataField
            .PivotFields("% SCARTO ROTTURE MECC. FILO").Orientation = xlDataField
            .PivotFields("% SCARTO ROTTURE MECC. PONTE CARICO").Orientation = xlDataField
            .PivotFields("% SCARTO ROTTURE MECC. SQUADRATRICI").Orientation = xlDataField
            .PivotFields("% SCARTO RIGHE NON PARALLELE").Orientation = xlDataField
            .PivotFields("% SCARTO CORTE").Orientation = xlDataField
        End With
        Set pvtTable = ActiveSheet.PivotTables("Tabella_pivot5")
        For Each pvtField In pvtTable.DataFields
            pvtField.NumberFormat = "0.00%"
        Next pvtField
        Worksheets("taglio_mese").ChartObjects(1).Activate
        With ActiveChart
            .PlotArea.Select
            .SetElement (msoElementDataLabelShow)
            .SetElement (msoElementChartTitleAboveChart)
            .SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
            With .Axes(xlCategory, xlPrimary)
                With .AxisTitle
                    .Text = "MESE"
                    .Font.Size = 16
                End With
                .TickLabels.Font.Size = 16
            End With
            With .Axes(xlValue)
                .MajorUnit = 0.0005
                .MinimumScale = 0
                .MaximumScale = 0.005
                .TickLabels.Font.Size = 16
            End With
            With .ChartTitle
                 .Text = _
                 "TOTALE % SCARTO LASTRE TAGLIO LD"
                 .HorizontalAlignment = xlCenter
                 .Font.Size = 28
            End With
            With .Legend.Font
                .Size = 16
            End With
            Target_t = Sheets("equivalenti").Range("N7").Value
            With .Shapes.AddTextbox(msoTextOrientationHorizontal, 1690, 270, 150, 24)
                With .TextFrame.Characters
                     .Text = "Obiettivo " & Sheets("equivalenti").Range("N5").Value & "     " & Format(Target_t, "Percent")
                     .Font.Color = RGB(255, 255, 255)
                     .Font.Size = 14
                End With
                 .Fill.ForeColor.RGB = RGB(192, 80, 77)
            End With
            X = .ChartArea.Left + ActiveChart.PlotArea.InsideLeft
            Y = .ChartArea.Top + ActiveChart.PlotArea.InsideTop + 27
            x1 = X + ActiveChart.PlotArea.InsideWidth
            step = ActiveChart.Axes(xlValue).Height / (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale)
            y1 = step * (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale - (Target_t - ActiveChart.Axes(xlValue).MinimumScale))
            With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, X, Y + y1, x1, Y + y1)
                 .Select
                .Line.ForeColor.RGB = RGB(255, 0, 0)
                 .Line.DashStyle = msoLineSolid
                 .Line.Weight = 3
             End With
            NameLine = Selection.Name
        End With
        For X = 1 To ActiveSheet.ChartObjects(1).Chart.SeriesCollection.Count
            With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(X)
                .DataLabels.Font.Size = 16
             End With
        Next X
            With ActiveSheet.ChartObjects(1).Chart
                .SeriesCollection(1).Interior.Color = RGB(69, 114, 167)
               .SeriesCollection(2).Interior.Color = RGB(170, 70, 67)
                .SeriesCollection(3).Interior.Color = RGB(137, 165, 78)
                .SeriesCollection(4).Interior.Color = RGB(113, 88, 143)
                .SeriesCollection(5).Interior.Color = RGB(65, 152, 175)
                .SeriesCollection(6).Interior.Color = RGB(147, 169, 207)
                .SeriesCollection(7).Interior.Color = RGB(209, 147, 146)
            End With
[...]
End Sub

Upvotes: 0

Views: 1397

Answers (2)

user3514930
user3514930

Reputation: 1717

I've not found where the value it's stored, but we can obtain the value dinamically for every chart using this macro (to start only the first time):

Public NameLine As String
Public DisX, DisY As Double

Sub FindDisXY()
    Dim TmpX, TmpY As Double

    ActiveSheet.ChartObjects("Chart 14").Activate
    TmpX = ActiveChart.PlotArea.Left
    TmpY = ActiveChart.PlotArea.Top
    ActiveChart.PlotArea.Left = -12
    ActiveChart.PlotArea.Top = -12

    DisX = -ActiveChart.PlotArea.Left
    DisY = -ActiveChart.PlotArea.Top
    ActiveChart.PlotArea.Left = TmpX
    ActiveChart.PlotArea.Top = TmpY
End Sub

This macro move the PlotArea in one area NOT POSSIBLE (-12,-12) after Get the Left & Top and move back the PlotArea.
The values of Left & Top gets, are equals to the disallignment... Try to use with your different charts. If Work, we have a possible solution. I search a lot, by I don't found this value stored.
The two values shall be substitute in the lines:

x = Selection.Left + ActiveChart.PlotArea.InsideLeft + DisY
y = Selection.Top + ActiveChart.PlotArea.InsideTop + DisX

Upvotes: 0

user3514930
user3514930

Reputation: 1717

To create the Line (in a module):

Public NameLine As String

Sub LinePt()
    ActiveSheet.ChartObjects("Chart 14").Activate
    x = Selection.Left + ActiveChart.PlotArea.InsideLeft + Range("C10").Value
    y = Selection.Top + ActiveChart.PlotArea.InsideTop + Range("C9").Value
    x1 = x + ActiveChart.PlotArea.InsideWidth
    step = ActiveChart.Axes(xlValue).Height / (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale)
    y1 = step * (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale - (Range("C8").Value - ActiveChart.Axes(xlValue).MinimumScale))

    ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x, y + y1, x1, y + y1).Select
    NameLine = Selection.Name
End Sub

To change in accordance at a value stored in C8 (Inside the sheet):

Private Sub Worksheet_Change(ByVal Target As Range)
    xx = ActiveCell.Address

    ActiveSheet.ChartObjects("Chart 14").Activate
    x = Selection.Left + ActiveChart.PlotArea.InsideLeft + Range("C10").Value
    y = Selection.Top + ActiveChart.PlotArea.InsideTop + Range("C9").Value
    x1 = x + ActiveChart.PlotArea.InsideWidth
    step = ActiveChart.Axes(xlValue).Height / (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale)
    y1 = step * (ActiveChart.Axes(xlValue).MaximumScale - ActiveChart.Axes(xlValue).MinimumScale - (Range("C8").Value - ActiveChart.Axes(xlValue).MinimumScale))

    ActiveSheet.Shapes.Range(Array(NameLine)).Select
    Selection.Top = y + y1
    Selection.Left = x
    Selection.Width = x1 - x

    Range(xx).Select
End Sub

The cells C9 and C10 are two value of correction (value = 4) that I don't find where you are stored (property). If you change size or value the line update the position. If you resize the chart, not.

Upvotes: 1

Related Questions