ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: willson_62

[求助] 请教PPT之VBA问题,急!!!

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-9-23 22:17 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
谢谢laose朋友的回答,我在国外网站找到一段检测Placeholders集合中对象的索引值的脚本,粘贴如下,希望对大家有用!

Sub Object_Types_on_This_Slide()
    'Refers to each object on the current page and returns the Shapes.Type
    'Can be very useful when searching through all objects on a page
    Dim it As String
    Dim i As Integer
    Dim Ctr As Integer
    '''''''''''''''''
    'Read-only  Long
    '''''''''''''''''
    For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count
        'No need to select the object in order to use it
        With ActiveWindow.Selection.SlideRange.Shapes(i)

        'But it is easier to watch when the object is selected
        'This next line is for demonstration purposes only.
        'It is not necessary
        ActiveWindow.Selection.SlideRange.Shapes(i).Select

        Select Case .Type

            'Type 1
            Case msoAutoShape
                it = "an AutoShape. Type : " & .Type

            'Type 2
            Case msoCallout
                it = "a Callout. Type : " & .Type

            'Type 3
            Case msoChart
                it = "a Chart. Type : " & .Type

            'Type 4
            Case msoComment
                it = "a Comment. Type : " & .Type

            'Type 5
            Case msoFreeform
                it = "a Freeform. Type : " & .Type

            'Type 6
            Case msoGroup
                it = "a Group. Type : " & .Type

            ' If it's a group them iterate thru
            ' the items and list them

                it = it & vbCrLf & "Comprised of..."
                For Ctr = 1 To .GroupItems.Count
                    it = it & vbCrLf & _
                        .GroupItems(Ctr).Name & _
                        ". Type:" & .GroupItems(Ctr).Type
                Next Ctr

            'Type 7
            Case msoEmbeddedOLEObject
                it = "an Embedded OLE Object. Type : " & .Type

            'Type 8
            Case msoFormControl
                it = "a Form Control. Type : " & .Type

            'Type 9
            Case msoLine
                it = "a Line. Type : " & .Type

            'Type 10
            Case msoLinkedOLEObject
                it = "a Linked OLE Object. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & "My Source: " & _
                        .SourceFullName
                End With

            'Type 11
            Case msoLinkedPicture
                it = "a Linked Picture. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & "My Source: " & _
                        .SourceFullName
                End With

            'Type 12
            Case msoOLEControlObject
                it = "an OLE Control Object. Type : " & .Type

            'Type 13
            Case msoPicture
                it = "a embedded picture. Type : " & .Type

            'Type 14
            Case msoPlaceholder
                it = "a text placeholder (title or regular text--" & _
                     "not a standard textbox) object." & _
                     "Type : " & .Type

            'Type 15
            Case msoTextEffect
                it = "a WordArt (Text Effect). Type : " & .Type

            'Type 16
            Case msoMedia
                it = "a Media object .. sound, etc. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & " My Source: " & _
                    .SourceFullName
                End With

            'Type 17
            Case msoTextBox
                it = "a Text Box."

            'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
            'Case msoScriptAnchor
            Case 18
                it = " a ScriptAnchor. Type : " & .Type

            'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
            'Case msoTable
            Case 19
                it = " a Table. Type : " & .Type

            'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
            'Case msoCanvas
            Case 20
                it = " a Canvas. Type : " & .Type

            'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
            'Case msoDiagram
            Case 22
                it = " a Diagram. Type : " & .Type

            'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInk
            Case 22
                it = " an Ink shape. Type : " & .Type

            'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInkComment
            Case 23
                it = " an InkComment. Type : " & .Type


            'Type -2
            Case msoShapeTypeMixed
                it = "a Mixed object (whatever that might be)." & _
                     "Type : " & .Type

            'Just in case
            Case Else
                it = "a mystery!? An undocumented object type?" & _
                        " Haven't found one of these yet!"
        End Select

        MsgBox ("I'm " & it)
        End With
    Next i
End Sub

TA的精华主题

TA的得分主题

发表于 2010-9-24 16:35 | 显示全部楼层

回复 11楼 willson_62 的帖子

这段代码检索的是对象类型,不是对象索引号啊!

TA的精华主题

TA的得分主题

 楼主| 发表于 2010-9-25 16:41 | 显示全部楼层
楼上说得对,现在我还没有找索引号的对应属性,急等!

TA的精华主题

TA的得分主题

发表于 2023-4-29 10:11 | 显示全部楼层
yvhgydn 发表于 2010-9-23 13:24
举个示例
ActivePresentation.Slides(1).Shapes.Placeholders.count
当前PPT中第一个幻灯片中所有占位符 ...

没理解PlaceHolders翻译为占位符的表述。
NotesPage.Shapes.PlaceHolders与Shapes.PlaceHolders的区别???

Set pTxtRng = Sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange


ActivePresentation.Slides(1).Shapes.Placeholders.count

TA的精华主题

TA的得分主题

发表于 2023-5-1 07:37 | 显示全部楼层
打开PPsx

  1. Sub ll()
  2.     Dim Fso As Scripting.FileSystemObject
  3.         Set Fso = New Scripting.FileSystemObject
  4.     Dim PathFile
  5.         PathFile = ThisWorkbook.Path & "\t\t.ppsx"
  6.     Dim Str, SqlStr
  7.     Dim Ppt As PowerPoint.Application
  8.     Dim Pres As Presentation
  9.     Dim Sld As Slide
  10.     Dim Shp 'As Shape
  11.         Set Ppt = New PowerPoint.Application
  12.         Ppt.Visible = msoCTrue
  13.         If Fso.FileExists(PathFile) Then
  14.             If Ppt.Presentations.Count = 0 Then
  15.                  Set Pres = Ppt.Presentations.Open(PathFile)
  16.             Else
  17.                  Set Pres = Ppt.Presentations(PathFile)
  18.             End If
  19.         Else
  20.             MsgBox PathFile
  21.         End If
  22.         For Each Sld In Pres.Slides
  23.              Str = Sld.NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
  24.              Debug.Print Str,
  25.              Set Shp = Sld.Shapes("Date")
  26.              Debug.Print Shp.Width, Shp.Height
  27.         Next Sld
  28.         Stop
  29.         
  30.         Stop
  31.         
  32.         Stop
  33.         Stop
  34.         
  35.         'Ppt.Quit
  36. End Sub
复制代码

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-4 01:13 , Processed in 0.048900 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表