删除值为零的数据标签然后重置 - VBA

时间:2018-04-26 17:24:21

标签: vba excel-vba loops charts excel

如果单元格的值为0%,我有一个代码可以从自定义饼图中删除数据标签。但是,由于我的代码循环以便数据发生变化,我完全丢失了该特定类别的标签,因此当添加一组新数据且值不为零时,标签不再出现。我如何做到这一点,当值为0时,数据标签被删除,但当值为零时,它将重新出现,基本上重置图表的原始设置,以便所有值/类别都有数据标签。 / p>

  Sub ChartLoop()

       Range("D2").Select
        ActiveCell.Range("C1:E1").Select

    Dim myPDF As String
    Dim i As Long

        For counter = 2 To 21

            Sheets("CF").Select
            Range("'CF'!$D$" & counter & ":$F$" & counter).Select 'numbers
            Selection.Copy
            Sheets("CF-Chart").Select
            Range("B1:B3").Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True

  'this is for removing the data labels        
        Dim iPts As Integer
        Dim nPts As Integer
        Dim aVals As Variant
        Dim srs As Series

        ActiveSheet.ChartObjects("Chart 5").Activate
            For Each srs In ActiveChart.SeriesCollection
                With srs
                    If .HasDataLabels Then
                        nPts = .Points.Count
                        aVals = .Values
                        For iPts = 1 To nPts
                            If aVals(iPts) = 0 Then
                                .Points(iPts).HasDataLabel = False
                            End If
                        Next
                    End If
                End With
            Next


           ActiveSheet.ChartObjects("Chart 5").Activate
           ActiveChart.ChartArea.Select
           myPDF = "\\stchsfs\arboari$\Profile-Data\Desktop\Export Trial1\c2-" & Sheets("CF").Range("C" & i + 2).Value2 & ".pdf"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPDF, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        i = i + 1
        Next counter

    End Sub

第一张图表是我常规图表的样子。第二个图表是我想要删除值为0的数据标签,但保留数据标签的类别和值为其他值为> 0的值。 Chart1 Chart2

谢谢!

1 个答案:

答案 0 :(得分:0)

也许改变

If aVals(iPts) = 0 Then
    .Points(iPts).HasDataLabel = False
End If

到此?

If aVals(iPts) = 0 Then
    .Points(iPts).HasDataLabel = False
    .DataLabels.ShowValue = False
Else
    .Points(iPts).HasDataLabel = True
    .DataLabels.ShowValue = True
End If

编辑4-27-2018

好的......我已经测试了这个解决方案,它对我有用。不是最优雅,但它的工作原理。让我知道它是否适合你 -

ActiveSheet.ChartObjects("Chart 5").Activate

With ActiveChart.SeriesCollection(1)
    For i = 1 To .Points.Count
        If .Points(i).HasDataLabel = False Then
            .Points(i).Select
            ActiveChart.SetElement (msoElementDataLabelShow)
                If .Points(i).DataLabel.Text = 0 Then
                    .Points(i).HasDataLabel = False
                    .Points(i).DataLabel.ShowValue = False
                End If
        ElseIf .Points(i).DataLabel.Text = 0 Then
            .Points(i).HasDataLabel = False
            .Points(i).DataLabel.ShowValue = False
        End If
    Next i
End With