PPT里我写了个VBA，竟然出现这种情况

VBA_learner · 发表于 2014-8-23 14:22

所有的代码如下：其功能就是让柱形图标的每根柱子能够变颜色
Dim cht As Chart
Dim chtData As ChartData
Dim wb As Object
Dim ws As Object
Dim shp As Shape

Sub creatchart()
Set shp = ActivePresentation.Slides(1).Shapes.AddChart(xlBarClustered, 20, 50, 600, 400)
If shp.Type = msoChart Then
Set cht = shp.Chart
End If
If cht Is Nothing Then Exit Sub
Set wb = cht.ChartData.Workbook
Set ws = wb.worksheets(1)
ws.listobjects(1).resize ws.Range("A1:B5")
ws.Range("B1").Value = "sldjlkad"
ws.Range("A2:B2").Value = Array("American", 14.8)
ws.Range("A3:B3").Value = Array("China", 5.3)
ws.Range("A4:B4").Value = Array("Japan", 5)
ws.Range("A5:B5").Value = Array("German", 3.5)
cht.ApplyDataLabels xlDataLabelsShowValue
'ActivePresentation.Slides(1).ChartObjects("aa").SeriesCollection(1).Points(1).Interior.ColorIndex = 3
cht.SeriesCollection(1).Points(1).Interior.ColorIndex = 5
' wb.Application.Quit
End Sub

Sub ss()
' Dim shp1 As Shape
' Dim cht1 As Chart
' Dim wb As Object
Set shp = ActivePresentation.Slides(1).Shapes(1)
Set cht = shp.Chart
cht.SeriesCollection(1).Points(3).Interior.ColorIndex = 1 问题出在这个语句上，无论这个值怎么改变，柱形都是红色的。3才是红色，可换成1照样也还是红色。
End Sub

求高手帮忙解决

mmwwdd · 发表于 2014-8-23 15:02

上个附件看盾

VBA_learner · 发表于 2014-8-23 16:00

mmwwdd 发表于 2014-8-23 15:02
上个附件看盾

showColorVba.rar (56.56 KB, 下载次数: 16)

taller · 发表于 2014-8-23 17:19

这里的ColorIndex属性无效，需要使用Color属性，也许算个小BUG吧

Sub ss()
Set cht = Nothing
Set shp = ActivePresentation.Slides(1).Shapes(2)
Set cht = shp.Chart
Set p = cht.SeriesCollection(1).Points(3)
cht.SeriesCollection(1).Points(3).Interior.Color = RGB(0, 0, 255)
cht.ApplyDataLabels xlDataLabelsShowValue
End Sub

复制代码

ning84 · 发表于 2023-2-27 20:01

taller 发表于 2014-8-23 17:19
这里的ColorIndex属性无效，需要使用Color属性，也许算个小BUG吧

肯定是在 shp.chart出错。Shp as Shape???

ning84 · 发表于 2023-2-28 12:48

如何通过Excel VBA修改Powerpoint Chart ChartData | 码农家园 https://www.codenong.com/55490180/

Sub ModifyChartData()
Dim pptApp As Object
Dim pptPres As Presentation
Set pptApp = GetObject(,"PowerPoint.Application")
Set pptPres = pptApp.ActivePresentation
pptPres.Slides(4).Shapes("Diagramm1").Chart.ChartTitle.Text ="Sales Overview"
pptPres.Slides(4).Shapes("Diagramm1").Chart.ChartData.Activate
Chart.ChartData.Workbook.Worksheets("Tabelle1").Range("B2:B5").Value = 50
Workbooks.Close
End Sub

复制代码

Ppt2007为什么没有Chart???

ning84 · 发表于 2023-2-28 15:19

在Ppt2019，直接定义Dim Chart，简单方便。
Ppt2007和Ppt2003要绕了一个大弯子-----------OLEFormat.

Sub M()
Dim Pres As Presentation
Dim Sld As Slide
Dim Shp As Shape, ShpRng As ShapeRange
Dim oChart As Chart, ChartArr()
Dim oForm As OLEFormat, Wk As Workbook
Set Shp = Application.ActivePresentation.Slides(1).Shapes(1)
Debug.Print Shp.Name
Shp.Select msoTrue
Set oForm = ActiveWindow.Selection.ShapeRange.OLEFormat
Debug.Print TypeName(oForm.Object)
Set Wk = oForm.Object
ReDim ChartArr(Wk.Charts.Count - 1)
For ii = 1 To Wk.Charts.Count
'Debug.Print oChart.Name, Wk.Name
Set ChartArr(ii - 1) = Wk.Charts(ii)
Next ii
For ii = 0 To UBound(ChartArr)
Set oChart = ChartArr(ii)
With oChart
Debug.Print .Name,
Debug.Print .HasDataTable, .HasLegend, .HasTitle
End With
Next ii
End Sub

复制代码

ning84 · 发表于 2023-2-28 19:33

闹了天，原来是Office安装的问题。

Private Sub del()
Dim Sld As Slide
Dim Shp As Shape
Dim oChart As Chart
For Each Sld In Application.ActivePresentation.Slides
For Each Shp In Sld.Shapes
Set oChart = Shp.Chart
Debug.Print Shp.Name, Sld.Name,
With oChart
Debug.Print .Name, .HasDataTable, .HasLegend, .HasTitle,
Debug.Print .SeriesCollection.Count
End With
Next Shp
Next Sld
End Sub

复制代码

ning84 · 发表于 2023-2-28 19:35

闹了天，原来是Office安装的问题。

Private Sub del()
Dim Sld As Slide
Dim Shp As Shape
Dim oChart As Chart
For Each Sld In Application.ActivePresentation.Slides
For Each Shp In Sld.Shapes
Set oChart = Shp.Chart
Debug.Print Shp.Name, Sld.Name,
With oChart
Debug.Print .Name, .HasDataTable, .HasLegend, .HasTitle,
Debug.Print .SeriesCollection.Count
End With
Next Shp
Next Sld
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] PPT里我写了个VBA，竟然出现这种情况