【发布时间】：2014-07-11 08:11:06
【问题描述】：
Excel 2007，VB 6.3
我创建了一个数据透视图（来自数据透视表的图表）类型 xlCylinderColStacked。 y 轴刻度：最小 0%，最大 2%。 我想在目标水平 0.7% 处添加一条水平线（目标不固定，但应取自另一张工作表中的另一个单元格：Target = Sheets("equivalenti").Range("N6") .值) 命令应该类似于
.Shapes.AddLine(60, vertical_position, 940, vertical_position).Line
我尝试创建一个公式来计算给定 .Axes(xlValue).MaximumScale, .Axes(xlValue).MinimumScale, .ChartArea.Top, .PlotArea.Height 的垂直位置，但我找不到解决方案。任何想法？
基本上，如果我知道左上角的原点的确切位置（y 轴上的 0%）作为 .top 和 .left 测量的参考，基本上可以很容易地放置水平线ChartArea。
我在下面报告了四分之二图表的完整代码（在一种情况下更正为 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
【问题讨论】：
标签： vba excel charts pivot-table