2017-12-20 2 views
0

이 코드를 작성했지만 코드를 실행하면 차트 제목이 제거되지 않습니다. step-in 함수를 사용하여 코드를 수동으로 실행하면 완벽하게 작동합니다. newChart.HasTitle = False 줄 앞에 Application.Wait을 사용해 보았지만 작동하지 않는 것 같습니다. 어떤 아이디어?PowerPoint에서 차트 제목을 제거하지 않습니다.

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 

답변

0

내 자신의 문제에 대한 해결책은 첫째

If newChart.HasTitle = True Then 
     newChart.HasTitle = False 
End If 
대신이

newChart.HasTitle = True 
newChart.HasTitle = False 

처럼 그들을 제거 후 차트 제목을 강제로 보인다

관련 문제