Ppt-VBA的层级太多，搞得人晕晕乎乎。

ning84

表格里填个数据，需要多少个层级Shp.Table.Cell(ii, jj).Shape.TextFrame.TextRange还不能填数据，最后一个层级是Text.
在要把这个表格美化一下，还需要做多少部工作。

1. Sub del()
   
2.    Dim Pres As Presentation
   
3.    Dim Shp As Shape
   
4.    Dim Sld As Slide
   
5.    Dim Rr, Cc
   
6.       Rr = 10
   
7.       Cc = 3
   
8.       Set Pres = Application.ActivePresentation
   
9.       Set Sld = Pres.Slides(1)
   
10.       For Each Shp In Sld.Shapes
    
11.            Debug.Print Shp.Name
    
12.            Shp.Delete
    
13.       Next Shp
    
14.       ''
    
15.       Set Shp = Sld.Shapes.AddTable(Rr, Cc, 20, 10, 400)
    
16.       
    
17.       For ii = 1 To Rr
    
18.            
    
19.            For jj = 1 To Cc
    
20.                With Shp.Table.Cell(ii, jj).Shape.TextFrame.TextRange
    
21.                    .Text = "行" & ii & ",列" & jj
    
22.                    .Font.Size = 15
    
23.                End With
    
24.                Shp.Table.Columns.Item(jj).Width = 150
    
25.            Next jj
    
26.            Shp.Table.Rows.Item(ii).Height = 3
    
27.          
    
28.       Next ii
    
29.       
    
30. End Sub
    

复制代码

ning84

主次坐标轴也是绕来绕去，半天不理解。

1. Sub DEL()
   
2.    Dim ObjChart As ChartObject
   
3.    Dim oChart As Chart
   
4.       For Each ObjChart In Sheet1.ChartObjects
   
5.            Set oChart = ObjChart.Chart
   
6.            With oChart
   
7.                  Debug.Print .Name
   
8.            End With
   
9.       Next ObjChart
   
10.       Debug.Print oChart.Name
    
11.       With oChart
    
12.           .HasTitle = True
    
13.           .HasDataTable = False
    
14.           .HasLegend = True
    
15.           '.HasPivotFields = True
    
16.           .ChartTitle.Characters.Text = "Chart Title"
    
17.         .Axes(xlCategory, xlPrimary).HasTitle = True
    
18.         .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Primary Category"
    
19.         .Axes(xlValue, xlPrimary).HasTitle = True
    
20.         .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Primary Value"
    
21.         .Axes(xlCategory, xlSecondary).HasTitle = True
    
22.         .Axes(xlCategory, xlSecondary).AxisTitle.Characters.Text = "Secondary Category"
    
23.         .Axes(xlValue, xlSecondary).HasTitle = True
    
24.         .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Secondary Value"
    
25.         Debug.Print .Legend.Left
    
26.         Stop
    
27.         .Legend.Left = 280
    
28.         .Legend.Top = 100
    
29.       End With
    
30. End Sub

复制代码

ning84

学习PPT-VBA就是要搞清楚层级关系。集合关系把人搞得晕晕乎乎，头晕脑胀理不清集合关系。
PowerPoint) (表对象 | Microsoft Learn  https://learn.microsoft.com/zh-cn/office/vba/api/powerpoint.table
Table 对象成员

代表幻灯片上的表格形状。Table 对象是 Shapes 集合的成员。Table 对象包含 Columns 集合和 Rows 集合。

方法

  名称 说明
ApplyStyle  对指定表格应用表格样式。
Cell  返回一个 Cell 对象，该对象代表表格中的一个单元格。
ScaleProportionally  按指定比例调整表格中所有单元格的高度和宽度、字号和内边距。

属性

  名称 说明
Application  返回一个 Application 对象，该对象表示指定对象的创建者。
Columns  返回一个 Columns 集合，该集合代表表格中的所有列。只读。有关返回集合中单个成员的信息，请参阅返回集合中的对象。
FirstCol  如果该属性值为 True，则显示指定表格的第一列的特殊格式。可读/写。
FirstRow  如果该属性值为 True，则显示指定表格的第一行的特殊格式。可读/写。
HorizBanding  如果该属性值为 True，则显示镶边行，这些行上的偶数行和奇数行的格式互不相同。可读/写。
LastCol  如果该属性值为 True，则显示指定表格的最后一列的特殊格式。可读/写。
LastRow  如果该属性值为 True，则显示指定表格的最后一行的特殊格式。可读/写。
Parent  返回指定对象的父对象。
Rows  返回一个 Rows 集合，该集合代表表格中的所有行。只读。有关返回集合中单个成员的信息，请参阅返回集合中的对象。
Style  返回一个 TableStyle 对象，该对象包含有关指定表格的当前表格样式的信息。
TableDirection  返回或设置表格单元格放置次序的方向。PpDirection 类型，可读/写。
VertBanding  如果该属性值为 True，则显示镶边列，这些列上的偶数列和奇数列的格式互不相同。可读/写。

1. Private Sub del25()
   
2.     Dim Ppt As PowerPoint.Application
   
3.     Dim Pres As Presentation
   
4.     Dim Sld As Slide
   
5.     Dim ShpRng As ShapeRange
   
6.     Dim Shp ' As Shape
   
7.     Dim oTab As Table, oCount
   
8.     Dim Rr, Cc, Left, Top, Width, Height
   
9.          Set Ppt = New PowerPoint.Application
   
10.          Ppt.Visible = msoTrue
    
11.          Set Pres = Ppt.ActivePresentation
    
12.          With Pres.PgeSetup
    
13.               .FirstSlideNumber = 1
    
14.               .SlideOrientation = msoOrientationVertical
    
15.               .NotesOrientation = msoOrientationVertical
    
16.          End With
    
17.          ''
    
18.          If Pres.Slide.Count > 0 Then
    
19.               Set Sld = Pres.Slides(Pres.Slides.Count)
    
20.               Sld.moveTo 1
    
21.               For Each Shp In Sld.Shapes
    
22.                    If Shp.Type = msoTable Then
    
23.                          Debug.Print Shp.Type, Shp.Name
    
24.                          Shp.Delete
    
25.                    End If
    
26.               Next Shp
    
27.          Else
    
28.               Set Sld = Pres.Slides.Add(1, ppLayoutBlank)
    
29.          End If
    
30.          
    
31.          Rr = 10: Cc = 4
    
32.          Left = 0: Top = 0
    
33.          Width = 400: Height = 400
    
34.          Set Shp = Sld.Shapes.AddTable(Rr, Cc, Left, Top, Width, Height)
    
35.          Shp.Select
    
36.          oCount = Ppt.ActiveWindow.Selection.ShapeRange.Count
    
37.          Set oTab = Ppt.ActiveWindow.Selection.ShapeRange(oCount).Table
    
38.          With oTab
    
39.               For jj = 1 To .Columns.Count
    
40.                   .Columns(jj).Width = 80
    
41.               Next jj
    
42.          End With
    
43.          ''
    
44.          For ii = 1 To Rr
    
45.              For jj = 1 To Cc
    
46.                  With oTab.Cell(ii, jj).Shape.TextFrame
    
47.                     With .TextRange
    
48.                        .Text = ii & "X" & jj & "=" & ii * jj
    
49.                        .Font.Size = 15
    
50.                        If jj = 1 Then
    
51.                            .Font.color.RGB = RGB(255, 0, 0) 'RGB(83, 134, 139)
    
52.                        End If
    
53.                     End With
    
54.                  End With
    
55.               Next jj
    
56.               oTab.Rows(ii).Height = 10
    
57.          Next ii
    
58.          Stop
    
59.          Ppt.Quit
    
60. End Sub

复制代码

ning84

自学PPT-VBA绝对是脑残人干的事。人工做好这个表，按帮助文件反推找出参数，死活结果不对。

1. Private Sub del()
   
2.    Dim Pres As Presentation
   
3.    Dim Shp As Shape
   
4.    Dim GrpChart As Graph.Chart
   
5.    
   
6.       Set Pres = Application.ActivePresentation
   
7.       Set GrpChart = Pres.Slides(1).Shapes(1).OLEFormat.Object
   
8.       With GrpChart
   
9.            Debug.Print .SeriesCollection.Count
   
10.            Stop
    
11.            For ii = 1 To .SeriesCollection.Count + 1
    
12.                  Debug.Print .SeriesCollection(ii).ChartType
    
13.            Next ii
    
14.       End With
    
15. End Sub

复制代码

Chart 对象成员

表示演示文稿中的图表。
方法

	名称	说明
	ApplyChartTemplate	MSDNUpdate
	ApplyCustomType	将标准图表类型或自定义图表类型应用于图表。
	ApplyDataLabels	将数据标签应用于图表中的所有系列。
	ApplyLayout	MSDNUpdate
	AutoFormat	MSDNUpdate
	Axes	返回一个代表图表上单个坐标轴或坐标轴集合的对象。
	ChartWizard	修改给定图表的属性。可使用本方法快速设定图表的格式，而不必逐个设置所有属性。本方法是非交互式的，并且仅更改指定的属性。
	CopyPicture	将所选对象作为图片复制到剪贴板。
	Export	以图形格式导出图表。Boolean 类型，可读/写。
	GetChartElement	返回指定的 X 和 Y 坐标处图表元素的信息。本方法的与众不同之处在于只需指定前两个参数的值。Microsoft Office PowerPoint 会为其余参数赋值，代码应在方法返回时检查这些值。
	Refresh	立即重新绘制指定的图表。
	SaveChartTemplate	MSDNUpdate
	SeriesCollection	返回一个对象，它代表图表或图表组中的单个系列（Series 对象）或所有系列的集合（SeriesCollection 集合）。
	SetDefaultChart	指定 Microsoft PowerPoint 新建图表时将使用的图表模板的名称。
	SetElement	MSDNUpdate
	SetSourceData	设置图表的源数据范围。

属性

	名称	说明
	AutoScaling	如果 Microsoft Office PowerPoint 对三维图表进行缩放，使之与等效的二维图表的大小相近，则为 True。RightAngleAxes 属性必须为 True。Boolean 类型，可读/写。
	BackWall	返回代表三维图表背景墙纸的 ChSurface 对象。使用返回的 ChSurface 对象的属性和方法设置指定图表的背景墙纸的格式。
	BarShape	返回或设置用于三维条形图或柱形图的形状。可读/写。
	ChartArea	返回一个 ChartArea 对象，该对象代表图表的整个图表区。只读。
	ChartData	返回或设置一个数组，该数组中包含将通过图表显示的值。
	ChartGroups	MSDNUpdate
	ChartStyle	MSDNUpdate 可读写。
	ChartTitle	返回一个 ChartTitle 对象，该对象代表指定图表的标题。只读。
	ChartType	返回一个 ChartTitle 对象，该对象代表指定图表的标题。只读。

ning84

Ppt-VBA实现下面效果不容易，自学太难。 Excel-VBA用宏录制可以实现。

1. Sub ConnectSunriseSunSet()
   
2.     Dim xlApp As Excel.Application
   
3.     Dim xlWk As Workbook
   
4.     Dim Sht As Worksheet
   
5.     Dim oCount
   
6.     Dim Str, Rr, Cc
   
7.     Dim Rng As Range
   
8.     Dim Arr()
   
9.         Str = "中国东西南北城市.xls"
   
10.         Set xlApp = New Excel.Application
    
11.         ''
    
12.         For Each xl In Workbooks
    
13.              If xl.Name = "中国东西南北城市.xls" Then
    
14.                  Set xlWk = xl
    
15.                  Exit For
    
16.              End If
    
17.             
    
18.         Next xl
    
19.         ''Debug.Print xlWk.Name
    
20.         'Application.Run xlWk.Name & "!MainConnectReturnArr"
    
21.         Set Sht = Sheet1 ' xlWk.Worksheets("Tmp")
    
22.         With Sht
    
23.             Set Rng = .Cells(1, 1).CurrentRegion
    
24.         End With
    
25.         With Rng
    
26.              'Debug.Print .Address, .Parent.Name, .Parent.Parent.Name, .Parent.Parent.Parent.Name
    
27.         End With
    
28.         ShtAddNewChart Rng
    
29.          
    
30. End Sub
    
31. 
    
32. Function ShtAddNewChart(Rng As Range)
    
33.      Dim ChartTypeArr
    
34.         ChartTypeArr = Array(xlColumnClustered, xlColumnClustered, xlLineMarkers, xlLineMarkers)
    
35.         Dim Sht As Sheet1
    
36.         Dim oChart As ChartObject
    
37.         Dim XlsChart As Chart
    
38.         Dim Shp As Shape
    
39.         Dim ii, jj
    
40.         Dim DataTab As DataTable
    
41.             Set Sht = Sheet1
    
42.             
    
43.             For Each XlsChart In Sheet1.Application.Charts '.ChartObjects
    
44.                  XlsChart.Select
    
45.                  'Application.ActiveWindow.SelectedSheets.Delete
    
46.                  ActiveWindow.SelectedSheets.Delete
    
47. 
    
48.             Next XlsChart
    
49.             Set XlsChart = Sht.Application.Charts.Add
    
50.             
    
51.             With XlsChart
    
52.                  
    
53.                  .HasDataTable = True
    
54.                  .HasLegend = False
    
55.                  .SetSourceData Source:=Sheet1.Range("A1:I5"), PlotBy:=xlRows 'Workbooks("中国东西南北城市.xls").Sheets("Tmp").Range("A1:I5"), PlotBy:=xlRows
    
56.                  Debug.Print Rng.Address, Rng.Parent.Name
    
57.                  
    
58.                  For ii = 1 To Rng.Rows.Count
    
59.                      
    
60.                      Debug.Print Rng(ii + 1, 10).Address
    
61.                      Debug.Print Rng(ii + 1, 10).Address, Rng(ii + 1, 10)
    
62.                      If ii >= 2 Then
    
63.                           Debug.Print ii - 1, ChartTypeArr(ii - 2)
    
64.                           .SeriesCollection(ii - 1).ChartType = Rng(ii, 10) 'ChartTypeArr(ii - 2)
    
65.                      End If
    
66.                     
    
67.                  Next ii
    
68.                  ''
    
69.                  .HasAxis(xlCategory, xlPrimary) = True
    
70.                  .HasAxis(xlCategory, xlSecondary) = False
    
71.                  .HasAxis(xlValue, xlPrimary) = True
    
72.                  .HasAxis(xlValue, xlSecondary) = True
    
73.                  With .Axes(xlValue, xlSecondary)
    
74.                       .MinimumScaleIsAuto = True
    
75.                       .MaximumScaleIsAuto = True
    
76.                       .MinorUnit = 5
    
77.                       .MajorUnit = 15
    
78.                       .Crosses = xlAutomatic
    
79.                       .ReversePlotOrder = False
    
80.                       .ScaleType = xlLinear
    
81.                       .DisplayUnit = xlNone
    
82.                  End With
    
83.                  With .PlotArea
    
84.                       .Left = 10
    
85.                       .Top = 5
    
86.                       .Width = 800
    
87.                       .Height = 300
    
88.                  End With
    
89. 
    
90.     With .Axes(xlValue)
    
91.         .MinimumScale = 0.3
    
92.         .MaximumScale = 0.8
    
93.         .MinorUnit = 0.2
    
94.         .MajorUnit = 0.4
    
95.         .Crosses = xlCustom
    
96.         .CrossesAt = 0.2
    
97.         .ReversePlotOrder = False
    
98.         .ScaleType = xlLinear
    
99.         .DisplayUnit = xlNone
    
100.     End With
     
101.     With .Axes(xlValue)
     
102.         .MinimumScale = 0.3
     
103.         .MaximumScale = 0.9
     
104.         .MinorUnit = 0.2
     
105.         .MajorUnit = 0.2
     
106.         .Crosses = xlCustom
     
107.         .CrossesAt = 0.2
     
108.         .ReversePlotOrder = False
     
109.         .ScaleType = xlLinear
     
110.         .DisplayUnit = xlNone
     
111.     End With
     
112.             End With
     
113.         
     
114.         
     
115. End Function

复制代码

ning84

添加31个Slide
先删除所有Slide

1. Sub del()
   
2.    Dim Pres As Presentation
   
3.    Dim Sld As Slide
   
4.    Dim Num
   
5.    Set Pres = Application.ActivePresentation
   
6.    Num = Pres.Slides.Count
   
7.    For ii = Num To 1 Step -1
   
8.         Set Sld = Pres.Slides(ii)
   
9.         Sld.Delete
   
10.    Next ii
    
11.    Stop
    
12.    For Each Sld In Pres.Slides
    
13.         Sld.Delete
    
14.    Next Sld
    
15.    
    
16.    Stop
    
17.    Dim Cc
    
18.    Dim ShpRng As ShapeRange
    
19.    Cc = Pres.Slides.Count
    
20.    For ii = 1 To 31
    
21.       
    
22.        Set Sld = Pres.Slides.Add(Index:=Cc + ii, Layout:=ppLayoutText)
    
23.        Set ShpRng = Sld.Shapes.Range(1)
    
24.       
    
25.        ShpRng.TextFrame.TextRange.Text = Pres.Slides.Count
    
26.    Next ii
    
27. End Sub

复制代码

ning84

MsoShapeType 枚举 (Office) | Microsoft Learn  https://learn.microsoft.com/zh-c ... office.msoshapetype

MsoShapeType 枚举 (Office)
项目
2023/04/07
8 个参与者
指定形状的类型或形状范围。

名称        值        Description
mso3DModel        30        3D 模型
msoAutoShape        1        自选图形
msoCallout        2        标注
msoCanvas        20        画布
msoChart        3        图表
msoComment        4        评论
msoContentApp        27        内容 Office 加载项
msoDiagram        21        图
msoEmbeddedOLEObject        7        嵌入式 OLE 对象
msoFormControl        8        窗体控件
msoFreeform        5        任意多边形
msoGraphic        28        图形
msoGroup        6        组
msoIgxGraphic        24        SmartArt 图形
msoInk        22        墨迹
msoInkComment        23        墨迹批注。
msoLine        9        折线图
msoLinked3DModel        31        链接的 3D 模型
msoLinkedGraphic        29        链接的图形
msoLinkedOLEObject        10        链接 OLE 对象。
msoLinkedPicture        11        链接图片。
msoMedia        16        媒体
msoOLEControlObject        12        OLE 控件对象。
msoPicture        13        图片
msoPlaceholder        14        占位符
msoScriptAnchor        18        脚本定位标记。
msoShapeTypeMixed        -2        混和形状类型。
msoSlicer        25        切片器
msoTable        19        表格
msoTextBox        17        文本框。
msoTextEffect        15        文本效果。
msoWebVideo        26        Web 视频

1. Sub ll1()
   
2.    Dim Pres As Presentation
   
3.        Set Pres = Application.ActivePresentation
   
4.    Dim Sld As Slide
   
5.    Dim Shp As Shape
   
6.    Dim txtFrm As TextFrame, txtFrm2 As TextFrame2
   
7.    Dim txtRng As TextRange
   
8.    ''
   
9.       For Each Sld In Pres.Slides
   
10.            For Each Shp In Sld.Shapes
    
11.                 Debug.Print Shp.Name, Shp.Type
    
12.            Next Shp
    
13.       Next Sld
    
14. End Sub
    

复制代码

ning84

ning84 发表于 2023-7-1 06:54
MsoShapeType 枚举 (Office) | Microsoft Learn  https://learn.microsoft.com/zh-cn/office/vba/api/offic ...

再温习一下typename的用法

1. Sub t()
   
2.     Dim Pres As Presentation
   
3.     Dim Sld As Slide, Shp As Shape
   
4.     Dim i
   
5.         Set Pres = Application.ActivePresentation
   
6.         Set Sld = Pres.Slides(3)
   
7.         For ii = 1 To Sld.Shapes.Count
   
8.             Set Shp = Sld.Shapes(ii)
   
9.             'Set pp = Shp.OLEFormat.Object
   
10.             Debug.Print Shp.Name,
    
11.             Debug.Print Shp.Type
    
12.             
    
13.         Next ii
    
14. End Sub
    

复制代码