Vba 在堆叠柱形图中隐藏序列的单列

Vba 在堆叠柱形图中隐藏序列的单列,vba,excel,charts,Vba,Excel,Charts,我目前有一个VBA脚本,它从一些数据生成一个组合图表。我的经理要求“总计”列(所有其他列的总和)出现在下面的数据表中。但是,他不希望它出现在图形本身中。我知道如果我手动执行此操作,我将能够双击带圆圈的列并将其填充设置为“无填充”,但我不知道如何在VBA中执行此操作。请注意,我并不是要隐藏整个系列,只是下面图片中带圆圈的列 我所拥有的: 我正在努力实现的目标: 谢谢你的时间 编辑:打印代码: 'Plotting! Dim dblMax As Double dblMax = Applicatio

我目前有一个VBA脚本,它从一些数据生成一个组合图表。我的经理要求“总计”列(所有其他列的总和)出现在下面的数据表中。但是,他不希望它出现在图形本身中。我知道如果我手动执行此操作,我将能够双击带圆圈的列并将其填充设置为“无填充”,但我不知道如何在VBA中执行此操作。请注意,我并不是要隐藏整个系列,只是下面图片中带圆圈的列

我所拥有的:

我正在努力实现的目标:

谢谢你的时间

编辑:打印代码:

'Plotting!
Dim dblMax As Double
dblMax = Application.WorksheetFunction.Max(dpws.Range("B2:P4"))
Dim chrt As Chart
Set chrt = pws.Shapes.AddChart.Chart
With chrt
    .ChartArea.Left = 200
    .ChartArea.Top = 0
    .ChartArea.Height = 500
    .ChartArea.Width = 800
    .Legend.Position = xlLegendPositionBottom
    .ChartType = xlColumnStacked
    .HasDataTable = True
    .SetSourceData Source:=dpws.UsedRange
    .SeriesCollection("Forecasted % Complete").AxisGroup = 2
    .SeriesCollection("Forecasted % Complete").ChartType = xlLineMarkers
    .SeriesCollection("Forecasted % Complete").MarkerStyle = xlMarkerStyleSquare
    .SeriesCollection("Cumulative").ChartType = xlLine
    .SeriesCollection("Cumulative").Format.Line.Visible = False
    .Axes(xlValue).MinimumScale = 0
    .Axes(xlValue).MaximumScale = dblMax + dblMax * 0.2
    .Axes(xlValue, xlSecondary).MinimumScale = 0
    .Axes(xlValue, xlSecondary).MaximumScale = 1
End With
下面是完整的代码

Sub MyCode()
Dim dws As Worksheet
Dim pws As Worksheet
Dim start As Range
Dim dataRange As Range
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim startPvt As String
Dim lastCol As Integer

'Create ChartBin, ChartDate columns.
Set dws = Sheets("Sheet1")
With dws
    lastCol = dws.Cells(1, .Columns.Count).End(xlToLeft).Column
    .Cells(1, lastCol + 1).Value = "Chart_Bin"
    .Cells(1, lastCol + 2).Value = "Chart_Date_Group"
End With


'Populate Chart Columns
Dim i As Long
Dim thisMonth As Integer
Dim hwswDateCol As Long
Dim statusCol As Long
Dim hwswDateGrpCol As Long
hwswDateCol = 162
statusCol = 13
hwswDateGrpCol = 163 'Really should search for these column titles.
thisMonth = Month(Date)
With dws
    For i = 2 To .UsedRange.Rows.Count Step 1
        .Cells(i, lastCol + 2).Value = .Cells(i, hwswDateGrpCol).Value
        'If complete...
        If (.Cells(i, statusCol) = "Complete") Then
            .Cells(i, lastCol + 1).Value = "Complete"
        'If not complete, date passed...
        ElseIf (thisMonth - Month(.Cells(i, hwswDateCol)) > 0) Then
            .Cells(i, lastCol + 1).Value = "Missed"
        Else
            .Cells(i, lastCol + 1).Value = "Forecasted"
        End If
    Next i
End With

'Copy just data we need to reduce pivot size.
Set rws = Sheets.Add
rws.Name = "Raw"
dws.Columns(1).Copy Destination:=rws.Columns(1)
dws.Columns(2).Copy Destination:=rws.Columns(2)
dws.Columns(4).Copy Destination:=rws.Columns(3)
dws.Columns(8).Copy Destination:=rws.Columns(4)
dws.Columns(10).Copy Destination:=rws.Columns(5)
dws.Columns(22).Copy Destination:=rws.Columns(6)
dws.Columns(131).Copy Destination:=rws.Columns(7)
dws.Columns(11).Copy Destination:=rws.Columns(8)
dws.Columns(101).Copy Destination:=rws.Columns(9)
dws.Columns(lastCol + 1).Copy Destination:=rws.Columns(10)
dws.Columns(lastCol + 2).Copy Destination:=rws.Columns(11)


'Create pivots.
Set pws = Sheets.Add
pws.Name = "Pivot"
Set start = rws.Range("A1")
Set dataRange = rws.Range(start, start.SpecialCells(xlLastCell))
startPvt = pws.Name & "!" & pws.Range("T1").Address(ReferenceStyle:=x1R1C1)
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange)
Set pvt = pvtCache.CreatePivotTable(TableDestination:=startPvt, TableName:="Market Totals")
pvt.PivotFields("Chart_Date_Group").Orientation = xlColumnField
pvt.PivotFields("Chart_Bin").Orientation = xlRowField
pvt.PivotFields("JOB NUMBER").Orientation = xlDataField

'Add slicers.
Dim sl As Slicer
Dim sls As Slicers
Dim slcs As SlicerCaches
Dim slc As SlicerCache
Set slcs = ActiveWorkbook.SlicerCaches
Set sls = slcs.Add(pws.PivotTables(1), "Carrier Type", "Carrier_Type").Slicers
Set sl = sls.Add(pws, , "Carrier_Type", "Carrier Type", 0, 0, 200, 75)
Set sls = slcs.Add(pws.PivotTables(1), "AVP", "AVP").Slicers
Set sl = sls.Add(pws, , "AVP", "AVP Type", 75, 0, 100, 250)
Set sls = slcs.Add(pws.PivotTables(1), "MARKET_RPA", "MARKET_RPA").Slicers
Set sl = sls.Add(pws, , "MARKET_RPA", "MARKET_RPA", 75, 100, 100, 400)
Set sls = slcs.Add(pws.PivotTables(1), "Driver", "Driver").Slicers
Set sl = sls.Add(pws, , "Driver", "Driver", 325, 0, 100, 150)
Set sls = slcs.Add(pws.PivotTables(1), "VENDOR", "VENDOR").Slicers
Set sl = sls.Add(pws, , "VENDOR", "VENDOR", 475, 0, 100, 150)
Set sls = slcs.Add(pws.PivotTables(1), "Hardware Location", "Hardware_Location").Slicers
Set sl = sls.Add(pws, , "Hardware_Location", "Hardware Location", 475, 100, 100, 200)
Set sls = slcs.Add(pws.PivotTables(1), "IWOS Flag", "IWOS_Flag").Slicers
Set sl = sls.Add(pws, , "IWOS_Flag", "IWOS Flag", 675, 0, 200, 125)

'Add data to data prep worksheet.
Dim dpws As Worksheet
Set dpws = Sheets.Add
dpws.Name = "Data Prep"
dpws.Cells(2, 1).Value = "Complete"
dpws.Cells(3, 1).Value = "Forecasted"
dpws.Cells(4, 1).Value = "Missed"
dpws.Cells(5, 1).Value = "Cumulative"
dpws.Cells(6, 1).Value = "Forecasted % Complete"
dpws.Cells(1, 2).Value = "2015"
dpws.Cells(1, 3).Value = "2016 Jan"
dpws.Cells(1, 4).Value = "2016 Feb"
dpws.Cells(1, 5).Value = "2016 Mar"
dpws.Cells(1, 6).Value = "2016 Apr"
dpws.Cells(1, 7).Value = "2016 May"
dpws.Cells(1, 8).Value = "2016 Jun"
dpws.Cells(1, 9).Value = "2016 Jul"
dpws.Cells(1, 10).Value = "2016 Aug"
dpws.Cells(1, 11).Value = "2016 Sep"
dpws.Cells(1, 12).Value = "2016 Oct"
dpws.Cells(1, 13).Value = "2016 Nov"
dpws.Cells(1, 14).Value = "2016 Dec"
dpws.Cells(1, 15).Value = "2017"
dpws.Cells(1, 16).Value = "2018"

For i = 2 To dpws.UsedRange.Columns.Count Step 1
    dpws.Cells(2, i).Value = WorksheetFunction.IfError(pvt.GetPivotData("JOB NUMBER", "Chart_Bin", "Complete", "Chart_Date_Group", dpws.Cells(1, i).Value), 0)
    dpws.Cells(3, i).Value = WorksheetFunction.IfError(pvt.GetPivotData("JOB NUMBER", "Chart_Bin", "Forecasted", "Chart_Date_Group", dpws.Cells(1, i).Value), 0)
    dpws.Cells(4, i).Value = WorksheetFunction.IfError(pvt.GetPivotData("JOB NUMBER", "Chart_Bin", "Missed", "Chart_Date_Group", dpws.Cells(1, i).Value), 0)
Next i
dpws.Cells(1, 17).Value = "Grand Total"
dpws.Cells(2, i) = pvt.GetPivotData("JOB NUMBER", "Chart_Bin", "Complete")
dpws.Cells(3, i) = pvt.GetPivotData("JOB NUMBER", "Chart_Bin", "Forecasted")
dpws.Cells(4, i) = pvt.GetPivotData("JOB NUMBER", "Chart_Bin", "Missed")
dpws.Cells(5, i) = pvt.GetPivotData("JOB NUMBER")



'Calculate percentages/cumulatives.
Dim grandTotalCol As Integer
Dim percentageRow As Integer
Dim sumRow As Integer
Dim prevValue As Double
prevValue = 0
grandTotalCol = i
sumRow = 5
percentageRow = 6

With dpws
    For i = 2 To dpws.UsedRange.Columns.Count Step 1
        .Cells(sumRow, i).Value = WorksheetFunction.Sum(.Range(.Cells(2, i), .Cells(4, i))) + prevValue
        prevValue = .Cells(sumRow, i).Value
        If i = dpws.UsedRange.Columns.Count - 1 Then
            prevValue = 0
        End If
        .Cells(percentageRow, i).Value = dpws.Cells(sumRow, i).Value / dpws.Cells(5, grandTotalCol).Value
        .Cells(percentageRow, i).NumberFormat = "0%"
    Next i
End With

'Plotting!
Dim dblMax As Double
dblMax = Application.WorksheetFunction.Max(dpws.Range("B2:P4"))
Dim chrt As Chart
Set chrt = pws.Shapes.AddChart.Chart
With chrt
    .ChartArea.Left = 200
    .ChartArea.Top = 0
    .ChartArea.Height = 500
    .ChartArea.Width = 800
    .Legend.Position = xlLegendPositionBottom
    .ChartType = xlColumnStacked
    .HasDataTable = True
    .SetSourceData Source:=dpws.UsedRange
    .SeriesCollection("Forecasted % Complete").AxisGroup = 2
    .SeriesCollection("Forecasted % Complete").ChartType = xlLineMarkers
    .SeriesCollection("Forecasted % Complete").MarkerStyle = xlMarkerStyleSquare
    .SeriesCollection("Cumulative").ChartType = xlLine
    .SeriesCollection("Cumulative").Format.Line.Visible = False
    .Axes(xlValue).MinimumScale = 0
    .Axes(xlValue).MaximumScale = dblMax + dblMax * 0.2
    .Axes(xlValue, xlSecondary).MinimumScale = 0
    .Axes(xlValue, xlSecondary).MaximumScale = 1
End With



End Sub

刚刚在原来的“绘图”部分添加了两行代码

Dim dblMax As Double
dblMax = Application.WorksheetFunction.Max(dpws.Range("B2:P4"))
Dim chrt As Chart
Set chrt = pws.Shapes.AddChart.Chart

With chrt
    .ChartArea.Left = 200
    .ChartArea.Top = 0
    .ChartArea.Height = 500
    .ChartArea.Width = 800
    .Legend.Position = xlLegendPositionBottom
    .ChartType = xlColumnStacked
    .HasDataTable = True
    .SetSourceData Source:=dpws.UsedRange
    .SeriesCollection("Forecasted % Complete").AxisGroup = 2
    .SeriesCollection("Forecasted % Complete").ChartType = xlLineMarkers
    .SeriesCollection("Forecasted % Complete").MarkerStyle = xlMarkerStyleSquare
    .SeriesCollection("Cumulative").ChartType = xlLine
    ' Added the 2 lines below
    .SeriesCollection("Cumulative").Format.Fill.Visible = msoFalse
    .SeriesCollection("Cumulative").Format.Line.Visible = msoFalse
    .Axes(xlValue).MinimumScale = 0
    .Axes(xlValue).MaximumScale = dblMax + dblMax * 0.2
    .Axes(xlValue, xlSecondary).MinimumScale = 0
    .Axes(xlValue, xlSecondary).MaximumScale = 1
nd With

你能发布你的代码吗?完成了!策划的东西可能是最相关的。非常感谢Shai的反馈。我最终用.points方法找到了一个解决方案,但你的方法更干净。