PowerPoint不会删除图表标题

问题描述 投票:0回答:1

我编写了这段代码,但代码在运行时无法删除图表标题。如果我使用步入功能手动运行代码,它可以很好地工作。我尝试在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
vba charts title powerpoint-vba
1个回答
0
投票

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

newChart.HasTitle = True
newChart.HasTitle = False

代替

If newChart.HasTitle = True Then
        newChart.HasTitle = False
End If
© www.soinside.com 2019 - 2024. All rights reserved.