Удаление меток данных со значениями ноль, а затем сброс - VBA - PullRequest
0 голосов
/ 26 апреля 2018

У меня есть код, который удаляет метки данных с настраиваемой круговой диаграммы, если значение ячейки равно 0%. Тем не менее, так как мой код зацикливается так, что данные меняются, я полностью теряю метку для этой конкретной категории, поэтому, когда добавляется новый набор данных и значение не равно нулю, метка больше не появляется. Как мне сделать так, чтобы при значении 0 метка данных удалялась, но когда значение не равно нулю, оно снова появлялось, по существу сбрасывая исходную настройку диаграммы, чтобы все значения / категории имели метки данных.

  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 голосов
/ 26 апреля 2018

Может измениться

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...