Shapes.AddTable，如何选择Ppt的表格不同模板。

ning84 · 发表于 2023-2-6 07:00

PPT表格有好几种表格模板。下面程序插入的表格只有一种模板。
如何更换表格模板？

Sld.Shapes.AddTable(Rr, Cc, Left, Top, Width, Height)----如何选择不同的模板。

Private Sub del25()
Dim Pres As Presentation
Dim Sld As Slide
Dim ShpRng As ShapeRange
Dim Shp ' As Shape
Dim oTab As Table, oCount
Dim Rr, Cc, Left, Top, Width, Height
Set Pres = Presentations.Add ' Ppt.ActivePresentation
With Pres.PageSetup
.FirstSlideNumber = 1
.SlideOrientation = msoOrientationVertical
.NotesOrientation = msoOrientationVertical
End With
''
If Pres.Slides.Count > 0 Then
Set Sld = Pres.Slides(Pres.Slides.Count)
Sld.moveTo 1
For Each Shp In Sld.Shapes
If Shp.Type = msoTable Then
Debug.Print Shp.Type, Shp.Name
Shp.Delete
End If
Next Shp
Else
Set Sld = Pres.Slides.Add(1, ppLayouBlank)
End If
Rr = 10: Cc = 4
Left = 50: Top = 380
Width = 400: Height = 400
Set Shp = Sld.Shapes.AddTable(Rr, Cc, Left, Top, Width, Height)
Shp.Select
oCount = Ppt.ActiveWindow.Selection.ShapeRange.Count
Set oTab = Ppt.ActiveWindow.Selection.ShapeRange(oCount).Table
With oTab
For jj = 1 To .Columns.Count
.Columns(jj).Width = 80
Next jj
End With
''
For ii = 1 To Rr
For jj = 1 To Cc
With oTab.Cell(ii, jj).Shape.TextFrame
With .TextRange
.Text = ii & "X" & jj & "=" & ii * jj
.Font.Size = 20
If jj = 1 Then
.Font.color.RGB = RGB(255, 0, 0) 'RGB(83, 134, 139)
End If
End With
End With
Next jj
oTab.Rows(ii).Height = 10
Next ii
Stop
Ppt.Quit
End Sub

复制代码

lss001 · 发表于 2023-2-6 12:51

本帖最后由 lss001 于 2023-2-6 16:24 编辑

Sub 设置ppt表格模板样式以及数据()
'新建表格时使用
With ActivePresentation.Slides(1) '指定幻灯片
      With .Shapes.AddTable(9, 7, 50, 100, 400, 200).Table
         '指定表格模板样式:深色样式 1
         .ApplyStyle _
         "{E8034E78-7F5D-4C2E-B375-FC64B27BC917}"
         For x = 1 To .Rows.Count '表格数据
            For y = 1 To .Columns.Count
                  .Cell(x, y).Shape.TextFrame. _
                  TextRange.Text = x + y
            Next
         Next
      End With
End With

' '修改表格时使用
' With ActivePresentation.Slides(1) '指定幻灯片
'       For i = 1 To .Shapes.Count '判断表格
'          If .Shapes(i).HasTable = msoTrue Then
'          With .Shapes(i).Table
'             '指定表格模板样式：浅色样式 1
'             .ApplyStyle _
'             "{9D7B26C5-4107-4FEC-AEDC-1716B250A1EF}"
'             For x = 1 To .Rows.Count '表格数据
'                   For y = 1 To .Columns.Count
'                      .Cell(x, y).Shape.TextFrame. _
'                      TextRange.Text = x + y
'                   Next
'             Next
'          End With
'          End If
'       Next
' End With
End Sub

'模板样式Id：
'"{9D7B26C5-4107-4FEC-AEDC-1716B250A1EF}" '浅色样式 1
'"{7E9639D4-E3E2-4D34-9284-5A2195B3D0D7}" '浅色样式 2
'"{616DA210-FB5B-4158-B5E0-FEB733F419BA}" '浅色样式 3
'"{793D81CF-94F2-401A-BA57-92F5A7B2D0C5}" '中度样式 1
'"{073A0DAA-6AF3-43AB-8588-CEC1D06C72B9}" '中度样式 2
'"{8EC20E35-A176-4012-BC5E-935CFFF8708E}" '中度样式 3
'"{D7AC3CCA-C797-4891-BE02-D94E43425B78}" '中度样式 4
'"{E8034E78-7F5D-4C2E-B375-FC64B27BC917}" '深色样式 1
'"{5202B0CA-FC54-4496-8BCA-5EF66A818D29}" '深色样式 2
'
'"{3B4B98B0-60AC-42C2-AFA5-B58CD77FA1E5}" '浅色样式 1 - 强调 1
'"{69012ECD-51FC-41F1-AA8D-1B2483CD663E}" '浅色样式 2 - 强调 1
'"{BC89EF96-8CEA-46FF-86C4-4CE0E7609802}" '浅色样式 3 - 强调 1
'"{B301B821-A1FF-4177-AEE7-76D212191A09}" '中度样式 1 - 强调 1
'"{5C22544A-7EE6-4342-B048-85BDC9FD1C3A}" '中度样式 2 - 强调 1
'"{6E25E649-3F16-4E02-A733-19D2CDBF48F0}" '中度样式 3 - 强调 1
'"{69CF1AB2-1976-4502-BF36-3FF5EA218861}" '中度样式 4 - 强调 1
'"{125E5076-3810-47DD-B79F-674D7AD40C01}" '深色样式 1 - 强调 1
'"{0660B408-B3CF-4A94-85FC-2B1E0A45F4A2}" '深色样式 2 - 强调 1/强调 2
'
'"{0E3FDE45-AF77-4B5C-9715-49D594BDF05E}" '浅色样式 1 - 强调 2
'"{72833802-FEF1-4C79-8D5D-14CF1EAF98D9}" '浅色样式 2 - 强调 2
'"{5DA37D80-6434-44D0-A028-1B22A696006F}" '浅色样式 3 - 强调 2
'"{9DCAF9ED-07DC-4A11-8D7F-57B35C25682E}" '中度样式 1 - 强调 2
'"{21E4AEA4-8DFA-4A89-87EB-49C32662AFE0}" '中度样式 2 - 强调 2
'"{85BE263C-DBD7-4A20-BB59-AAB30ACAA65A}" '中度样式 3 - 强调 2
'"{8A107856-5554-42FB-B03E-39F5DBC370BA}" '中度样式 4 - 强调 2
'"{37CE84F3-28C3-443E-9E96-99CF82512B78}" '深色样式 1 - 强调 2
'"{91EBBBCC-DAD2-459C-BE2E-F6DE35CF9A28}" '深色样式 2 - 强调 3/强调 4
'
'"{C083E6E3-FA7D-4D7B-A595-EF9225AFEA82}" '浅色样式 1 - 强调 3
'"{F2DE63D5-997A-4646-A377-4702673A728D}" '浅色样式 2 - 强调 3
'"{8799B23B-EC83-4686-B30A-512413B5E67A}" '浅色样式 3 - 强调 3
'"{1FECB4D8-DB02-4DC6-A0A2-4F2EBAE1DC90}" '中度样式 1 - 强调 3
'"{F5AB1C69-6EDB-4FF4-983F-18BD219EF322}" '中度样式 2 - 强调 3
'"{EB344D84-9AFB-497E-A393-DC336BA19D2E}" '中度样式 3 - 强调 3
'"{0505E3EF-67EA-436B-97B2-0124C06EBD24}" '中度样式 4 - 强调 3
'"{D03447BB-5D67-496B-8E87-E561075AD55C}" '深色样式 1 - 强调 3
'"{46F890A9-2807-4EBB-B81D-B2AA78EC7F39}" '深色样式 2 - 强调 5/强调 6
'
'"{D27102A9-8310-4765-A935-A1911B00CA55}" '浅色样式 1 - 强调 4
'"{17292A2E-F333-43FB-9621-5CBBE7FDCDCB}" '浅色样式 2 - 强调 4
'"{ED083AE6-46FA-4A59-8FB0-9F97EB10719F}" '浅色样式 3 - 强调 4
'"{1E171933-4619-4E11-9A3F-F7608DF75F80}" '中度样式 1 - 强调 4
'"{00A15C55-8517-42AA-B614-E9B94910E393}" '中度样式 2 - 强调 4
'"{EB9631B5-78F2-41C9-869B-9F39066F8104}" '中度样式 3 - 强调 4
'"{C4B1156A-380E-4F78-BDF5-A606A8083BF9}" '中度样式 4 - 强调 4
'"{E929F9F4-4A8F-4326-A1B4-22849713DDAB}" '深色样式 1 - 强调 4
'
'"{5FD0F851-EC5A-4D38-B0AD-8093EC10F338}" '浅色样式 1 - 强调 5
'"{5A111915-BE36-4E01-A7E5-04B1672EAD32}" '浅色样式 2 - 强调 5
'"{BDBED569-4797-4DF1-A0F4-6AAB3CD982D8}" '浅色样式 3 - 强调 5
'"{FABFCF23-3B69-468F-B69F-88F6DE6A72F2}" '中度样式 1 - 强调 5
'"{7DF18680-E054-41AD-8BC1-D1AEF772440D}" '中度样式 2 - 强调 5
'"{74C1A8A3-306A-4EB7-A6B1-4F7E0EB9C5D6}" '中度样式 3 - 强调 5
'"{22838BEF-8BB2-4498-84A7-C5851F593DF1}" '中度样式 4 - 强调 5
'"{8FD4443E-F989-4FC4-A0C8-D5A2AF1F390B}" '深色样式 1 - 强调 5
'
'"{68D230F3-CF80-4859-8CE7-A43EE81993B5}" '浅色样式 1 - 强调 6
'"{912C8C85-51F0-491E-9774-3900AFEF0FD7}" '浅色样式 2 - 强调 6
'"{E8B1032C-EA38-4F05-BA0D-38AFFFC7BED3}" '浅色样式 3 - 强调 6
'"{10A1B5D5-9B99-4C35-A422-299274C87663}" '中度样式 1 - 强调 6
'"{93296810-A885-4BE3-A3E7-6D5BEEA58F35}" '中度样式 2 - 强调 6
'"{2A488322-F2BA-4B5B-9748-0D474271808F}" '中度样式 3 - 强调 6
'"{16D9F66E-5EB9-4882-86FB-DCBF35E3C3E4}" '中度样式 4 - 强调 6
'"{AF606853-7671-496A-8E4F-DF71F8EC918B}" '深色样式 1 - 强调 6

ning84 · 发表于 2023-2-6 13:37

本帖最后由 ning84 于 2023-2-6 21:06 编辑

来回看Ppt-VBA的帮助文件也没有早到解决方法。

就是提示错误。

也找不到oTab到底是如何选用模板的。
测试程序找到表格的 font,但找不到单元格的底色。

Function GoTable(oTab As Table)
With oTab
For ii = 1 To .Rows.Count
For jj = 1 To .Columns.Count
Debug.Print .Cell(ii, jj).Shape.TextFrame.TextRange.Text
Debug.Print .Application.Path
Debug.Print .Rows.Item(ii).Height
With .Cell(ii, jj).Shape.TextFrame.TextRange
Debug.Print .Font.Color.RGB
End With
Next jj
Debug.Print .Parent.Name, .Parent.Type
Next ii
End With
End Function
Sub ldl()
Dim Pres As Presentation
Dim Shp As Shape
Dim oTab As Table
Set Pres = Application.ActivePresentation
'Set Shp = Pres.Slides(1).Shapes.AddTable(2, 2, 0, 0, 0, 0)
For Each Shp In Pres.Slides(5).Shapes
If Shp.HasTable Then
With Shp
Debug.Print .Name
.Left = 5
.Top = 300
Set oTab = .Table
End With
GoTable oTab
End If
Next Shp
End Sub

复制代码

ning84 · 发表于 2023-2-7 06:49

lss001 发表于 2023-2-6 12:51
Sub 设置ppt表格模板样式以及数据()
'新建表格时使用
With ActivePresentation.Slides(1) '指定 ...

看帮助文件解决不了问题，非常感谢高手的回复，又学习一个知识点。

Table.ApplyStyle 方法 (PowerPoint) | Microsoft Learn https://learn.microsoft.com/zh-c ... nt.table.applystyle

对指定表格应用表格样式。

语法

expression. ApplyStyle( _StyleID_, _SaveFormatting_ )

表达一个代表 [color=var(--theme-visited)]Table 对象的变量。

参数

名称

必需/可选

数据类型

说明

StyleID可选String要应用的表格样式的标识符。
SaveFormatting可选Boolean如此保留表格格式。
另请参阅

[color=var(--theme-visited)]表对象

支持和反馈

有关于 Office VBA 或本文档的疑问或反馈？请参阅 [color=var(--theme-visited)]Office VBA 支持和反馈，获取有关如何接收支持和提供反馈的指南。

建议的内容

[color=var(--theme-visited)]TextFrame2 对象 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]Presentation.Slides 属性 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]Shapes.Range 方法 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]Slides.Item 方法 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]TextRange2 对象 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]Font 对象 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]SectionProperties 对象 (PowerPoint)
[size=0.875]Office VBA reference topic
[color=var(--theme-visited)]Shapes.Item 方法 (PowerPoint)
[size=0.875]Office VBA reference topic

Private Sub del()
Dim Pres As Presentation
Dim Sld As Slide
Dim Shp As Shape
Dim oTab As Table
Set Pres = Application.ActivePresentation
Set Sld = Pres.Slides(Pres.Slides.Count)
Set Shp = Sld.Shapes(Sld.Shapes.Count)
Set oTab = Shp.Table
With oTab
.ApplyStyle "{9D7B26C5-4107-4FEC-AEDC-1716B250A1EF}"
.ApplyStyle "{0660B408-B3CF-4A94-85FC-2B1E0A45F4A2}" '深色样式 2 - 强调 1/强调 2
.ApplyStyle "{93296810-A885-4BE3-A3E7-6D5BEEA58F35}" '中度样式 2 - 强调 6
For ii = 1 To .Rows.Count
''
.Rows(ii).Height = 6
For jj = 1 To .Columns.Count
''
With .Cell(ii, jj).Shape.TextFrame.TextRange
.Text = ii & "X" & jj & "=" & ii * jj
.Font.Size = 5
End With
Next jj
Next ii
End With
End Sub

复制代码

ning84 · 发表于 2023-2-7 22:38

本帖最后由 ning84 于 2023-2-8 15:54 编辑

又做了一遍题目，有点感觉。
再次感谢lss001的帮助。

幻灯片23.JPG

Private Sub del()
Dim Rng As Range
Dim Ppt As PowerPoint.Application
Dim Pres As Presentation
Dim Sld As Slide
Dim Shp 'As Shape
Dim oTab As Table
Dim TabRow As Integer, TabCol As Integer
Dim oSum, oNum As Integer
Dim FontSize
TabRow = 27
TabCol = 4
''
Set Ppt = New PowerPoint.Application
Ppt.Visible = msoTrue
Set Pres = Ppt.Presentations.Add
With Pres.PageSetup
.SlideSize = ppSlideSizeCustom
.SlideWidth = 720
.SlideHeight = 425
''.FirstSlideNumber = 1
.SlideOrientation = msoOrientationHorizontal
.NotesOrientation = msoOrientationVertical
End With
''
oSum = 1
oNum = 1
For kk = 1 To Rng.Rows.Count
With Pres
Set Sld = .Slides.Add(.Slides.Count + 1, ppLayoutBlank)
Sld.MoveTo .Slides.Count
End With
oSum = oSum + ii
Set Shp = Sld.Shapes.AddTable(TabRow, TabCol, 0, 0, 100)
With Shp
.Left = 10
.Top = 10
End With
Set oTab = Shp.Table
With oTab
For jj = 1 To TabCol
.Columns.Item(jj).Width = ww
Next jj
.ApplyStyle Rng(kk, 1), True
.Cell(1, 1).Merge .Cell(1, TabCol)
.Cell(1, 1).Shape.TextFrame.TextRange.Text = Rng(1, 2)
For ii = 2 To TabRow
For jj = 1 To TabCol
.Rows.Item(ii).Height = 1
.Cell(ii, jj).Shape.TextFrame.TextRange.Text = oNum & "+" & oSum & "=" & Application.WorksheetFunction.Text(oNum + oSum, "[DBNum1]")
oNum = oNum + 1
oSum = oSum + oNum
Next jj
Next ii
End With
Next kk
End Sub

复制代码

再优化一下

''
Function SldNewOneTable(Pres As Presentation, DataArr, TabSty, FontSize, MergeStr, Left, Top, TabRow, TabCol, ColWidArr)
Dim Sld As Slide
Dim Shp
Dim oTab As Table
Dim Sss
''
With Pres
Set Sld = .Slides.Add(.Slides.Count + 1, ppLayoutBlank)
Sld.MoveTo .Slides.Count
End With
If MergeStr = "" Then
Set Shp = Sld.Shapes.AddTable(TabRow, TabCol, 0, 0, 100)
Else
Set Shp = Sld.Shapes.AddTable(TabRow + 1, TabCol, 0, 0, 100)
End If
With Shp
.Left = Left
.Top = Top
End With
Set oTab = Shp.Table
With oTab
''
For jj = 1 To TabCol
.Columns.Item(jj).Width = ColWidArr(jj - 1)
Next jj
.ApplyStyle TabSty, True
If MergeStr = "" Then
Sss = 0
Else
Sss = 1
.ApplyStyle MergeStr, True
If TabCol > 1 Then
.Cell(1, 1).Merge .Cell(1, TabCol)
End If
.Cell(1, 1).Shape.TextFrame.TextRange.Text = MergeStr
End If
For ii = 1 To TabRow
For jj = 1 To TabCol
.Cell(Sss + ii, jj).Shape.TextFrame.TextRange.Text = DataArr(ii - 1, jj - 1)
.Cell(Sss + ii, jj).Shape.TextFrame.TextRange.Font.Size = FontSize
Next jj
.Rows.Item(Sss + ii).Height = 1
Next ii
End With
End Function

复制代码

ning84 · 发表于 2023-7-25 21:11

lss001 发表于 2023-2-6 12:51
Sub 设置ppt表格模板样式以及数据()
'新建表格时使用
With ActivePresentation.Slides(1) '指定 ...

Sub lll2()
Dim Arr(9)
Arr(0) = "{91EBBBCC-DAD2-459C-BE2E-F6DE35CF9A28}"
Arr(1) = "{46F890A9-2807-4EBB-B81D-B2AA78EC7F39}"
Arr(2) = "{5202B0CA-FC54-4496-8BCA-5EF66A818D29}"
Arr(3) = "{EB344D84-9AFB-497E-A393-DC336BA19D2E}"
Arr(4) = "{B301B821-A1FF-4177-AEE7-76D212191A09}"
Arr(5) = "{1E171933-4619-4E11-9A3F-F7608DF75F80}"
Arr(6) = "{69CF1AB2-1976-4502-BF36-3FF5EA218861}"
Arr(7) = "{91EBBBCC-DAD2-459C-BE2E-F6DE35CF9A28}"
Arr(8) = "{46F890A9-2807-4EBB-B81D-B2AA78EC7F39}"
Arr(9) = "{69CF1AB2-1976-4502-BF36-3FF5EA218861}"
Dim oNum, oNum1
Dim oStyle
oNum = 10
Dim Pres As Presentation
Set Pres = Application.ActivePresentation
Dim Sld As Slide, oTable As Table
For ii = 2 To Pres.Slides.Count
Set Sld = Pres.Slides(ii)
Set oTable = Sld.Shapes("oTable").Table
Debug.Print ii, (ii + oNum + oNum1) Mod oNum '+ 1 - 1
kk = (ii + oNum + oNum1) Mod oNum
oTable.ApplyStyle Arr(kk), True
Next ii
End Sub

复制代码

Dim Pres As Presentation
Dim Sld As Slide, Shp As Shape
Dim oTable As Table
Dim Str
Dim StyleArr(2)
Set Pres = Application.ActivePresentation
For ii = 2 To 11
Set Sld = Pres.Slides(ii)
Set oTable = Sld.Shapes("oTable").Table
Str = " Arr(" & ii - 2 & ")=""" & oTable.Style.Id & """"
Debug.Print Str
'Debug.Print oTable.Style.Id, oTable.Style.Name
Next ii
Stop

复制代码

ning84 · 发表于 2023-7-27 08:12

Sub sa()
Dim Pres As Presentation
Set Pres = Application.ActivePresentation
Dim oTable As Table
Set oTable = Pres.Slides(19).Shapes("oTable").Table
With oTable
.Cell(1, 1).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = 2
End With
End Sub

复制代码

ning84 · 发表于 2023-7-28 07:11

Slide.SlideShowTransition 属性
返回一个 SlideShowTransition 对象，该对象代表指定幻灯片切换的特殊效果。只读。
语法

表达式.SlideShowTransition

表达式一个代表 Slide 对象的变量。

返回值
SlideShowTransition
代码没有调试成功。

Sub ll()
Dim Pres As Presentation
Set Pres = Application.ActivePresentation
Dim Sld As Slide
Set Sld = Pres.Slides(1)
With Sld.SlideShowTransition
.SoundEffect.ImportFromFile "F:\1.mp3"
.AdvanceOnTime = msoCTrue
'.AdvanceTime = 1000
End With
End Sub

复制代码

ning84 · 发表于 2023-7-29 23:47

Sub ll()
Dim Pres As Presentation
Set Pres = Application.ActivePresentation
Dim Sld As Slide
For ii = 1 To Pres.Slides.Count
Set Sld = Pres.Slides(ii)
Sld.Export "F:\1\A" & Format(ii, "000") & ".JPG", "JPG", 1920, 2560
Next ii
End Sub

复制代码

ning84 · 发表于 2023-10-31 18:23

继续学习

Sub ll1()
Dim Pres As Presentation
Set Pres = Application.ActivePresentation
Dim Sld As Slide, Shp As Shape
Dim oTab As Table
Dim TableStyle
Dim Www, Ww, Hh
TableStyle = "2D5ABB26-0587-4C30-8999-92F81FD0307C}"
Set Sld = Pres.Slides(5)
Set Shp = Sld.Shapes(2)
Debug.Print Shp.Name
Shp.Delete
''
With Pres.PageSetup
Www = 500
Ww = .SlideWidth
Hh = .SlideHeight
End With
Set Shp = Sld.Shapes.AddTable(3, 2, (Ww - Www) / 2, Hh - Hh / 10 - 10, Www, 0)
Set oTab = Shp.Table
With oTab
.ApplyStyle TableStyle
For ii = 1 To .Rows.Count
For jj = 1 To .Columns.Count
.Cell(ii, jj).Shape.TextFrame.TextRange.Text = ii & "-" & jj
Next jj
Next ii
End With
End Sub

复制代码

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