Question

我已编写此代码，但代码无法在运行时删除图表标题。如果我使用步入功能手动运行代码，它可以很好地工作。我尝试在Application.Wait行之前使用newChart.HasTitle = False，但它似乎也无效。有什么想法吗？

Sub InsertPieCharts()
Dim xl As Excel.Application
Dim aTB As Table
Dim aSL As Slide
Dim sh As Shape
Dim newChart As Chart
Dim aTX As Shape
Dim chartAreasWidth As Double, chartAreasHeight As Double, firstLeft As Double, chartsHSpace As Double, chartsLeft As Double, chartsTop As Double, firstTop As Double, chartsVSpace As Double, tHeight As Double, tWidth As Double, cWidth As Double, cHeight As Double
Dim r As Integer, c As Integer

'Measures
chartAreasWidth = 25 'cm
chartAreasHeight = 4.4 'cm
firstLeft = 3.13 'cm
firstTop = 13.01 'cm
tHeight = 1 'cm
tWidth = 1 'cm
cWidth = 2.5 'cm
cHeight = 2.2 'cm

'Objects
Set xl = CreateObject("Excel.Application")
Set aSL = ActivePresentation.Slides(16)

For Each sh In aSL.Shapes
    If sh.HasTable Then
        If sh.Table.Cell(1, 1).Shape.TextFrame2.TextRange = "Datatable" Then
            Set aTB = sh.Table
            Exit For
        End If
    End If
Next sh

chartsHSpace = xl.CentimetersToPoints(chartAreasWidth / (aTB.Columns.Count - 1))
chartsVSpace = xl.CentimetersToPoints(chartAreasHeight / (aTB.Rows.Count - 2))
chartsLeft = xl.CentimetersToPoints(firstLeft)
chartsTop = xl.CentimetersToPoints(firstTop)
tHeight = xl.CentimetersToPoints(tHeight)
tWidth = xl.CentimetersToPoints(tWidth)
cHeight = xl.CentimetersToPoints(cHeight)
cWidth = xl.CentimetersToPoints(cWidth)


For r = 3 To aTB.Rows.Count
    For c = 2 To aTB.Columns.Count
        Set newChart = aSL.Shapes.AddChart2(-1, xlPie, chartsLeft - (cWidth - tWidth) / 2 + cWidth * (c - 2), chartsTop - (cHeight - tHeight) / 2 + cHeight * (r - 3), cWidth, cHeight).Chart
        With newChart.ChartData.Workbook.Sheets(1)
            .Cells(1, 2).Value = ""
            .Cells(2, 1).Value = "Fill"
            .Cells(2, 2).Value = aTB.Cell(r, c).Shape.TextFrame2.TextRange * 1
            .Cells(3, 2).Value = 100 - aTB.Cell(r, c).Shape.TextFrame2.TextRange
            .Cells(3, 1).Value = "Unfill"
            .Rows(4).Delete
            .Rows(4).Delete
        End With

        newChart.ChartData.Workbook.Close

        If newChart.HasTitle = True Then
            newChart.HasTitle = False
        End If
        If newChart.HasLegend = True Then
            newChart.HasLegend = False
        End If

        newChart.SeriesCollection(1).Points(1).Format.Fill.ForeColor.RGB = RGB(176, 176, 176)
        newChart.SeriesCollection(1).Points(2).Format.Fill.Visible = False




        Set aTX = aSL.Shapes.AddTextbox(msoTextOrientationHorizontal, chartsLeft + chartsHSpace * (c - 2), chartsTop + chartsVSpace * (r - 3), tWidth, tHeight)
        aTX.TextFrame2.TextRange = aTB.Cell(r, c).Shape.TextFrame2.TextRange
        aTX.TextFrame2.HorizontalAnchor = msoAnchorCenter
        aTX.TextFrame2.VerticalAnchor = msoAnchorMiddle
        aTX.AutoShapeType = msoShapeOval

        If aTB.Cell(r, c).Shape.TextFrame2.TextRange > 89.5 Then
            aTX.TextFrame2.TextRange.Font.Size = 14
            aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
            aTX.Fill.ForeColor.RGB = RGB(47, 105, 151)
        ElseIf aTB.Cell(r, c).Shape.TextFrame2.TextRange > 79.5 Then
            aTX.TextFrame2.TextRange.Font.Size = 14
            aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            aTX.Fill.ForeColor.RGB = RGB(169, 202, 228)
        ElseIf aTB.Cell(r, c).Shape.TextFrame2.TextRange > 69.5 Then
            aTX.TextFrame2.TextRange.Font.Size = 14
            aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
            aTX.Fill.ForeColor.RGB = RGB(255, 170, 170)
        ElseIf aTB.Cell(r, c).Shape.TextFrame2.TextRange >= 0 Then
            aTX.TextFrame2.TextRange.Font.Size = 14
            aTX.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
            aTX.Fill.ForeColor.RGB = RGB(255, 0, 0)
        End If

        If aTB.Cell(r, c).Shape.TextFrame2.TextRange > 99.5 Then
            aTX.TextFrame2.TextRange.Font.Size = 12
        Else
            aTX.TextFrame2.TextRange.Font.Size = 14
        End If

        aTX.Width = tWidth
        aTX.Height = tHeight

    Next c
Next r

End Sub

Answer 1

我自己的问题的解决方案似乎首先强制图表标题，然后像这样删除它们

newChart.HasTitle = True
newChart.HasTitle = False

而不是

If newChart.HasTitle = True Then
        newChart.HasTitle = False
End If

PowerPoint不会删除图表标题

1 个答案: