数据透视图中的透视图/原点位置处的macros添加线
Excel 2007，VB 6.3
我创build了一个数据透视图（来自数据透视表的图表）typesxlCylinderColStacked。 轴y尺度：最小0％，最大2％。 我想在0.7％的目标水平添加一条水平线（目标不是固定的，但是应该从另一个工作表的另一个单元中取： Target = Sheets（“equivalenti”）。Range（“N6”）。Value ）命令应该是这样的
.Shapes.AddLine(60, vertical_position, 940, vertical_position).Line 我试图创build一个公式来计算vertical_position给定.Axes（xlValue）.MaximumScale，.Axes（xlValue）.MinimumScale，.ChartArea.Top，.PlotArea.Height但我找不到解决scheme。 任何想法？
基本上，如果我从左上angular知道原点的精确位置（y轴上的0％），则可以很容易地放置水平线，这将作为ChartArea上的.top和.left度量的参考。
我在下面的全部代码中报告四个图表中的两个（校正在一个案例中是8个，在另一个案例中是27个 – 我只关心垂直位置）
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
创build线（在模块中）：
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
要按照C8中存储的值进行更改（在表单内）：
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
单元格C9和C10是两个修正值（值= 4），我没有find你存储在哪里（属性）。 如果您更改大小或值，则更新该位置。 如果你调整图表，不是。
我没有find它存储的值，但是我们可以使用这个macros来为每个图表build立一个值（仅在第一次启动时）：
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
这个macros在得到Left＆Top之后将PlotArea移到一个不可能的区域（-12，-12），并移回PlotArea。
Left＆Top获取的值等于分离…尝试使用不同的图表。 如果工作， 我们有一个可能的解决scheme。 我search了很多，我没有发现这个值存储。
这两个值应该代替线：
x = Selection.Left + ActiveChart.PlotArea.InsideLeft + DisY y = Selection.Top + ActiveChart.PlotArea.InsideTop + DisX