Excel 2007，VB 6.3
我创建了一个数据透视表（数据透视表中的图表）类型xlCylinderColStacked。轴y刻度：最小0％，最大2％。 我想在0.7％的目标水平上添加一条水平线（目标不固定，但应从另一张纸中的另一个单元格中取出：目标=表格（“等值”）。范围（“N6”） .value的） 命令应该像
.Shapes.AddLine(60, vertical_position, 940, vertical_position).Line
我尝试创建一个公式来计算给定的vertical_position .Axes（xlValue）.MaximumScale，.Axes（xlValue）.MinimumScale，.ChartArea.Top，.PlotArea.Height但我找不到解决方案。任何的想法？
基本上，如果我从左上角知道原点的准确位置（y轴y％），那么就可以很容易地放置水平线，作为.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
答案 0 :(得分：1)
创建Line（在模块中）：
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），我找不到存储的位置（属性）。如果更改大小或值，该行将更新位置。如果你调整图表的大小，不是。
答案 1 :(得分：0)
我没有找到它存储的值的位置，但我们可以使用此宏（仅在第一次启动时）为每个图表获取dinamically值：
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
这个宏将PlotArea移动到Get the Left＆amp;之后的一个区域中是不可能的（-12，-12）。顶部并移回PlotArea 左和右的价值观Top得到，等于分配...尝试使用不同的图表。如果有工作， 我们有 可能的解决方案。我搜索了很多，因为我没有发现存储这个值 这两个值应替换为以下行：
x = Selection.Left + ActiveChart.PlotArea.InsideLeft + DisY
y = Selection.Top + ActiveChart.PlotArea.InsideTop + DisX