2017-12-20 3 views
0

このコードを記述しましたが、実行時にコードがチャートのタイトルを削除できません。ステップイン関数を使用してコードを手動で実行すると、完全に機能します。 私はの前にnewChart.HasTitle = False行を試してみましたが、どちらもうまくいかないようです。何か案は?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 

のようにそれらを削除した後、チャートのタイトルを強制しているようです

関連する問題