VBA在PPt中的应用

ning84 · 发表于 2014-12-15 08:19

本帖最后由 ning84 于 2014-12-15 15:10 编辑

PPT2003

Sub L1()
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
With ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font
.NameAscii = "黑体"
.NameOther = "黑体"
.NameFarEast = "黑体"
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 44
ActiveWindow.Selection.TextRange.Font.Color.RGB = RGB(Red:=255, Green:=0, Blue:=0)
ActivePresentation.ExtraColors.Add RGB(Red:=255, Green:=255, Blue:=255)
ActiveWindow.Selection.SlideRange.Shapes("Rectangle 3").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
With ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font
.NameAscii = "华文中宋"
.NameOther = "华文中宋"
.NameFarEast = "华文中宋"
End With
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Font.Size = 20
End Sub

复制代码

wudixin96 · 发表于 2014-12-15 08:35

你这是分享啊，还是？？？

录制的代码没啥好分享的吧

ning84 · 发表于 2014-12-15 11:41

本帖最后由 ning84 于 2014-12-15 11:46 编辑

wudixin96 发表于 2014-12-15 08:35
你这是分享啊，还是？？？

录制的代码没啥好分享的吧

这不是录制的宏，是PPT设计技术的一道习题
你要是对PPT的VBA比较熟悉，问一个问题。

如何获得.Shapes("Rectangle 2")的"Rectangle 2"名

也就是如何遍历shapes

wudixin96 · 发表于 2014-12-15 15:40

ning84 发表于 2014-12-15 11:41
这不是录制的宏，是PPT设计技术的一道习题
你要是对PPT的VBA比较熟悉，问一个问题。

那你看这本书里的宏也是录的，这么多SELECT，只是录过后，又手工整理了下。Name属性取不到你想要的吗？

ning84 · 发表于 2014-12-15 18:02

本帖最后由 ning84 于 2014-12-16 16:09 编辑

Private Sub ll()
With ActivePresentation
nn = .Slides.Count
For ii = 1 To nn
Debug.Print .Slides(ii).Name,
With .Slides(ii)
Debug.Print .Shapes.Count,
For jj = 1 To .Shapes.Count
Debug.Print .Shapes(jj).Name,
Next jj
End With
Debug.Print
Next ii
End With
End Sub

复制代码

ning84 · 发表于 2014-12-17 08:08

本帖最后由 ning84 于 2014-12-17 08:14 编辑

第27章　VBA中PowerPoint应用程序对象的应　
27.1　Application对象　
27.1.1　ActivePressentation属性　
【练习27-1】为当前演示文稿添加打开密码　
27.1.2　ActiveWindow属性　
27.1.3　AddIns属性　
【练习27-2】为PowerPoint添加加载项　
27.1.4　SlideShowWindows属性　
【练习27-3】调整幻灯片放映窗口的大小　
27.1.5　Windows属性　
27.1.6　Activate方法　
27.1.7　Quit方法　
27.1.8　Run方法　
27.2　Presentation对象　
27.2.1　BuiltInDocumentProperties属性　
【练习27-4】为当前演示文稿添加属性　
27.2.2　PageSetup属性　
【练习27-5】调整演示文稿中幻灯片的编号和尺寸　
27.2.3　ColorSchemes属性　
27.2.4　SlideMaster属性　
【练习27-6】在幻灯片母版中添加图片和自选图形　
27.2.5　AddTitleMaster方法　
【练习27-7】在幻灯片母版中添加标题母版　
27.2.6　ApplyTemplate方法　
27.2.7　ApplyTheme方法　
27.2.8　Close方法　
27.2.9　Save方法/SaveAs方法　
【练习27-8】批量保存后关闭所有打开的演示文稿　
27.3　Slides对象　
27.3.1　Background属性　
【练习27-9】设置偶数序号的幻灯片背景格式　
27.3.2　BackgroundStyle属性　
27.3.3　Comments属性　
27.3.4　Design属性　
27.3.5　HeadersFooters属性　
27.3.6　SlideID属性　
【练习27-10】批量添加幻灯片并为其设置动画效果　
27.3.7　AddSlide方法　
27.3.8　Copy/Cut方法　
27.3.9　Delete方法　
27.3.10　Paste方法　
27.4　CellRange对象/Cell对象　
27.4.1　Borders属性　
【练习27-11】调整单元格的边框样式和粗细　
27.4.2　Count属性　
27.4.3　Select属性　
【练习27-12】美化表格中的指定单元格　
27.4.4　Merge方法　
27.4.5　Split方法　
27.5　Chart对象　
27.5.1　BackWall属性　
27.5.2　BarShape属性　
27.5.3　ChartColor属性　
27.5.4　ChartData属性　
27.5.5　ChartStyle属性　
27.5.6　ChartTitle属性　
27.5.7　ChartType属性　
27.5.8　DataTable属性　
27.5.9　Legend属性　
【练习27-13】美化幻灯片中的图表　
27.5.10　ApplyLayout方法　
27.5.11　Axes方法　
27.5.12　ChartWizard方法　
27.5.13　SetBackgroundPicture方法　
27.5.14　SetSourceData方法　
27.6　Shape对象　
27.6.1　AutoShapeType属性　
27.6.2　BackgroundStyle属性　
27.6.3　ShapeStyle属性　
27.6.4　Top/Left属性　
27.6.5　Visible属性　
27.6.6　Width/Height属性　
27.6.7　SetShapesDefaultProperties方法　
【练习27-14】在幻灯片中添加相同格式的形状　
27.7　Font对象　
27.7.1　Bold属性　
27.7.2　Color属性　
27.7.3　Emboss属性　
27.7.4　Shadow属性　
27.7.5　Size属性　
27.7.6　Replace方法　
【练习27-15】设置幻灯片中的字体属性　

*****************************************【练习27-12】美化表格中的指定单元格提供的代码
Sub 美化表格中的指定单元格()
Dim celSelected As Cell
ActiveWindow.Selection.SlideRange.Shapes("内容占位符 4").Select
Set celSelected = ActiveWindow.Selection.ShapeRange.Table.Columns(1).Cells(1)
If celSelected.Selected Then
      With celSelected
         .Borders(ppBorderTop).ForeColor.RGB = RGB(255, 255, 255)
         .Borders(ppBorderLeft).ForeColor.RGB = RGB(255, 255, 255)
         .Borders(ppBorderRight).ForeColor.RGB = RGB(255, 255, 255)
         .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
      End With
End If
End Sub

ning84 · 发表于 2014-12-17 08:18

本帖最后由 ning84 于 2014-12-17 08:20 编辑

27.3.2　BackgroundStyle属性　
27.3.3　Comments属性　
27.3.4　Design属性　
27.3.5　HeadersFooters属性　
27.3.6　SlideID属性　
【练习27-10】批量添加幻灯片并为其设置动画效果　

Sub 添加幻灯片并设置动画效果()
Dim i As Integer
Set gslides = ActivePresentation.Slides
For i = 2 To 5
graphSlideID = gslides.Add(i, ppLayoutChart).SlideID
With gslides.FindBySlideID(graphSlideID)
.BackgroundStyle = msoBackgroundStylePreset4
.SlideShowTransition.EntryEffect = ppEffectCoverLeft
End With
Next
End Sub

复制代码

批量添加幻灯片并为其设置动画效果.zip (148.82 KB, 下载次数: 146)

weiyingde · 发表于 2016-7-25 16:27

干吗不用With……end with 精简代码呀？

ning84 · 发表于 2024-8-11 02:25

ning84 发表于 2014-12-17 08:08
第27章　VBA中PowerPoint应用程序对象的应　
27.1　Application对象　
27.1.1　ActivePressentation属性 ...

Sub 美化表格中的指定单元格()
Dim celSelected As Cell
ActiveWindow.Selection.SlideRange.Shapes("内容占位符 4").Select
Set celSelected = ActiveWindow.Selection.ShapeRange.Table.Columns(1).Cells(1)
If celSelected.Selected Then
      With celSelected
         .Borders(ppBorderTop).ForeColor.RGB = RGB(255, 255, 255)
         .Borders(ppBorderLeft).ForeColor.RGB = RGB(255, 255, 255)
         .Borders(ppBorderRight).ForeColor.RGB = RGB(255, 255, 255)
         .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255)
      End With
End If
End Sub

PowerPoint 开发人员参考
ShapeRange 对象成员

代表一个形状范围，即某个文档中的一组形状。形状范围可以只包含文档中的一个形状，也可以包含该文档中的所有形状。

方法

  名称说明
Align  对齐指定形状区域中的形状。
Apply  适用于指定的形状格式，该格式已使用 PickUp 方法复制。
Copy  将指定对象复制到剪贴板。
Cut  删除指定对象并将其放到剪贴板中。
Delete  删除指定的对象。
Distribute  在指定的形状范围内均匀分布形状。可以指定是水平还是垂直分布形状，以及是在整个幻灯片中还是在它们原来所在的空间内分布形状。
Duplicate  创建指定的 ShapeRange 对象的副本，将新的形状或形状范围添加到 Shapes 集合中，然后返回新的 ShapeRange 对象。副本对象位于 Shapes 集合末尾。
Flip  绕水平或垂直轴翻转指定形状。
Group  将指定区域中的形状形成一组。以单个 Shape 对象返回分组后的形状。
IncrementLeft  以指定点数水平移动指定形状。
IncrementRotation  按指定度数改变指定形状绕 z 轴的旋转量。使用 Rotation 属性设置形状的绝对旋转量。
IncrementTop  以指定点数垂直移动指定形状。
Item  从指定集合中返回单个对象。
PickUp  复制指定形状的格式。用 Apply 方法可将复制的格式应用于其他形状。
Regroup  对指定的形状范围原先所属的分组进行重新组合。将重新组合的形状作为单个 Shape 对象返回。
RerouteConnections  重置连接符，使其以最短的路径连接形状。重置时，RerouteConnections 方法可能会断开连接符的两端并将其重新连接到形状的其他位置。
ScaleHeight  以指定的比例缩放图形高度。对于图片和 OLE 对象来说，可指明图形缩放是根据原尺寸还是当前尺寸。对于除图片和 OLE 对象以外的其他图形来说，缩放总是相对于当前高度而言。
ScaleWidth  根据指定的系数缩放图形宽度。对于图片和 OLE 对象来说，可指明图形缩放是根据原尺寸还是当前尺寸。对于图片和 OLE 对象以外的其他图形来说，总是相对于当前宽度进行缩放。
Select  选择指定的对象。
SetShapesDefaultProperties  将指定形状的格式应用于默认形状。使用该方法后所创建的形状将默认应用此格式。
Ungroup  取消指定形状或者形状区域中任意组合形状的组合。取消指定形状或形状区域中图片和 OLE 对象的组合。取消组合后的形状以单个 ShapeRange 对象的形式返回。
ZOrder  将指定的形状移到集合中其他形状的前面或后面（即更改该形状在 z-顺序中的位置）。

属性

  名称说明
ActionSettings  返回一个 ActionSettings 对象，该对象包含在幻灯片放映期间，当用户在指定形状或文本区域内单击或移动鼠标时所产生的动作的信息。只读。
Adjustments  返回一个 Adjustments 对象，该对象包含指定形状中所有调整的调整值。适用于代表自选图形、艺术字或连接符的任何 Shape 或 ShapeRange 对象。只读。
AlternativeText  返回或设置与 Web 演示文稿中的形状关联的替换文本。可读/写。String 类型。
AnimationSettings  返回一个 AnimationSettings 对象，该对象代表所有可应用于指定形状的动画的特殊效果。
Application  返回一个 Application 对象，该对象表示指定对象的创建者。
AutoShapeType  返回或设置指定的 Shape 或 ShapeRange 对象的形状类型，该对象必须代表自选图形，而不能代表直线、任意多边形图形或连接符。MsoAutoShapeType 类型，可读写。
BackgroundStyle  MSDNUpdate
BlackWhiteMode  返回或设置值，该值指示以黑白模式查看演示文稿时指定形状出现的形式。可读/写。MsoBlackWhiteMode 类型。
Callout  返回一个 CalloutFormat 对象，该对象包含指定形状的标注格式属性。适用于代表行标注的 Shape 或 ShapeRange 对象。只读。
Chart  MSDNUpdate
Child  如果该形状是子形状，或者如果形状区域内的所有形状都是同一个父形状的子形状，则属性值为 MsoTrue。只读。MsoTriState 类型。
ConnectionSiteCount  返回指定形状中的连结点的数量。只读。Long 类型。
Connector  确定指定的形状是否为连接符。只读。MsoTriState 类型。
ConnectorFormat  返回 ConnectorFormat 对象，包含连接符格式属性。适用于代表连接符的 Shape 或 ShapeRange 对象。只读。
Count  返回指定集合中的对象数目。
Creator  返回 Long 类型值，该值代表创建指定对象的应用程序创建者代码，该代码由四个字符构成。例如，如果对象是在 PowerPoint 中创建的，则此属性返回一个十六进制数 50575054。只读。
CustomerData  MSDNUpdate
Fill  返回一个 FillFormat 对象，该对象包含指定形状的填充格式属性。只读。
Glow  返回指定形状范围的发光格式。只读 msoGlowType 类型。
GroupItems  返回一个 GroupShapes 对象，该对象代表指定形状组中的单个形状。使用 GroupShapes 对象的 Item 方法可返回形状组中的单个形状。适用于代表组合形状的 Shape 或 ShapeRange 对象。只读。
HasChart  MSDNUpdate
HasTable  返回指定的形状是否为表。只读。MsoTriState 类型。
HasTextFrame  返回指定形状是否有文本框。只读。MsoTriState 类型。
Height  以磅为单位返回或设置指定对象的高度。用于 Master 对象时只读，Single 类型；用于所有其他对象时可读/写，Single 类型。
HorizontalFlip  返回指定的形状是否绕水平轴翻转。只读。MsoTriState 类型。
Id  返回一个 Long 类型值，该值标识形状或形状范围。只读。
Left  返回或设置一个 Single 类型值，该值代表从形状范围中最左侧形状的左边缘到幻灯片左边缘的距离（以磅为单位）。可读/写。
Line  返回一个 LineFormat 对象，该对象包含指定形状的线条格式属性。（对于线条来说，LineFormat 对象代表线条本身；而对于带有边框的形状来说，LineFormat 对象代表边框。）只读。
LinkFormat  返回 LinkFormat 对象，包含链接的 OLE 对象特有的属性。只读。
LockAspectRatio  确定在调整指定形状的大小时是否保持其原始比例。可读/写。MsoTriState 类型。
MediaType  返回 OLE 媒体类型。只读。PpMediaType 类型。
Name  创建形状时，Microsoft PowerPoint 自动以 ShapeType Number 的形式为其分配一个名称，其中 ShapeType 指明形状或自选图形的类型，Number 是在幻灯片上形状的集合中具有唯一性的整数。例如，为幻灯片上的形状自动生成的名称可以为 Placeholder 1、Oval 2 和 Rectangle 3。为了避免与自动分配的名称发生冲突，对用户定义的名称请不要使用 ShapeType Number 形式，其中 ShapeType 为一个用于自动生成名称的值，Number 为任意的正整数。形状范围必须至少包含一个形状。String 类型，可读/写。
Nodes  返回一个 ShapeNodes 集合，该集合代表指定形状的几何描述。适用于表示任意多边形图形的 ShapeRange 对象。
OLEFormat  返回 OLEFormat 对象，包含指定形状的 OLE 格式属性。适用于代表 OLE 对象的 Shape 或 ShapeRange 对象。只读。
Parent  返回指定对象的父对象。
ParentGroup  返回一个 Shape 对象，该对象代表子形状或子形状范围共同的父形状。
PictureFormat  返回一个 PictureFormat 对象，该对象包含指定形状的图片格式属性。适用于代表图片或 OLE 对象的 Shape 或 ShapeRange 对象。只读。
PlaceholderFormat  返回一个 PlaceholderFormat 对象，该对象包含占位符特有的属性。只读。
Reflection  返回指定形状范围的映像格式。只读 msoReflectionType 类型。
Rotation  返回或设置指定形状绕 z 轴旋转的角度。正值表示顺时针旋转，负值表示逆时针旋转。可读/写。Single 类型。
Script  返回一个代表 Microsoft PowerPoint 幻灯片上一段脚本代码的 Script 对象。在 PowerPoint 中，脚本与某个标记形状相关联。如果指定形状没有相关联的脚本，则不会返回任何值。只读。
Shadow  返回一个只读的 ShadowFormat 对象，该对象包含指定形状的阴影格式属性。
ShapeStyle  MSDNUpdate
SoftEdge  返回指定形状范围的柔化边缘格式。msoSoftEdgeType 类型，只读。
Table  返回一个 Table 对象，该对象代表某个形状或形状区域内的一个表格。只读。
Tags  返回一个代表指定对象的标签的 Tags 对象。只读。
TextEffect  返回一个 TextEffectFormat 对象，该对象包含指定形状的文本效果格式属性。适用于代表艺术字的 Shape 或 ShapeRange 对象。
TextFrame  返回一个 TextFrame 对象，该对象包含指定形状或母版文本样式的对齐方式和定位属性。
TextFrame2  MSDNUpdate
ThreeD  返回一个 ThreeDFormat 对象，该对象包含指定形状的三维效果格式属性。只读。
Top  返回或设置一个 Single 类型值，该值代表形状范围内最上方形状的上边缘到文档上边缘的距离。可读/写。
Type  返回一个 MsoShapeType 常量，该常量代表单个形状或形状范围内多个形状的类型。只读。
VerticalFlip  确定指定的形状是否绕垂直轴翻转。只读。MsoTriState 类型。
Vertices  以一系列坐标对的形式返回指定任意多边形顶点（和贝赛尔曲线的控点）的坐标。可以将此属性返回的数组用作 AddCurve 方法或 AddPolyline 方法的参数。只读。Variant 类型。
Visible  返回或设置指定对象的可见性或应用于指定对象的格式。可读/写。MsoTriState 类型。
Width  以磅为单位返回或设置指定对象的宽度。用于 Master 对象时只读，Single 类型；用于所有其他对象时可读/写，Single 类型。
ZOrderPosition  返回指定的形状在 z-顺序中的位置。只读。Long 类型

ning84 · 发表于 2024-8-11 09:31

自己出题自己做

Sub ff()
Dim Shp As Shape, ShpRng As ShapeRange, oShpRng As ShapeRange
Dim Str
Set ShpRng = Application.ActiveWindow.Selection.ShapeRange
Dim Shps As Shapes
Dim TxtRng As TextRange2
For ii = 1 To ShpRng.Count
Arr = msoShapeArr(ShpRng(ii))
Str = Space(10) & "Arr(" & ii - 1 & ")=array("
With ShpRng(ii)
'.Name = .TextFrame2.TextRange.Text
'.Name = "Txt1"
Str = Str & """" & .Name & """," & Arr(1) & "," & .BackgroundStyle & "," & .Left & "," & .Top & "," & .Width & "," & .Height & ")"
Debug.Print Str
'Debug.Print .TextFrame2.TextRange.Text, .Name, .Type, .AutoShapeType, .BackgroundStyle, .Left, .Top, .Width, .Height
End With
Next ii
End Sub
Sub ff1()
Dim Arr(2)
Dim ShpRng As ShapeRange
Dim Sld As Slide, Slds As Slides
Set Slds = Application.ActivePresentation.Slides
For Each Sld In Slds
ShpRngToPlace Sld
Next Sld
End Sub
Function ShpRngToPlace(Sld As Slide)
Dim Arr(2)
Arr(0) = Array("Txt1", msoShapeRightArrow, 0, 1, 1, 410, 30)
Arr(1) = Array("Txt2", msoShapeRectangle, 0, 435, 10, 200, 150)
Arr(2) = Array("Txt3", msoShapePlaque, 0, 255, 485, 210, 50)
Dim Shp As Shape, ShpRng As ShapeRange
Set ShpRng = Sld.Shapes.Range(Array("Txt3", "Txt2", "Txt1"))
''
For ii = 0 To UBound(Arr)
With ShpRng(ii + 1)
.AutoShapeType = Arr(ii)(1)
.Left = Arr(ii)(3)
.Top = Arr(ii)(4)
.Width = Arr(ii)(5)
.Height = Arr(ii)(6)
End With
Next ii
End Function

复制代码

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