ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] 如何将PPT中的自动编号变成手动编号?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-10-15 11:00 | 显示全部楼层 |阅读模式
本帖最后由 哈哈哈尔 于 2024-10-15 11:01 编辑

复制代码
  1. Sub ConvertAutoToManualNumbering()
  2.     Dim slide As slide
  3.     Dim shape As shape
  4.     Dim paragraph As ParagraphFormat
  5.     Dim paragraphText As String
  6.     Dim slideIndex As Integer
  7.     Dim shapeIndex As Integer
  8.     Dim paragraphIndex As Integer
  9.     Dim bulletNumber As Integer

  10.     ' 遍历每张幻灯片
  11.     For slideIndex = 1 To ActivePresentation.Slides.Count
  12.         Set slide = ActivePresentation.Slides(slideIndex)
  13.         
  14.         ' 遍历每个形状
  15.         For shapeIndex = 1 To slide.Shapes.Count
  16.             Set shape = slide.Shapes(shapeIndex)
  17.             
  18.             ' 检查形状是否是文本框
  19.             If shape.HasTextFrame Then
  20.                 If shape.TextFrame.HasText Then
  21.                     ' 重置编号
  22.                     bulletNumber = 1
  23.                     
  24.                     ' 遍历每段文字
  25.                     For paragraphIndex = 1 To shape.TextFrame.TextRange.Paragraphs.Count
  26.                         With shape.TextFrame.TextRange.Paragraphs(paragraphIndex)
  27.                             ' 判断是否有自动编号
  28.                             If .ParagraphFormat.Bullet.Type = ppBulletNumbered Then
  29.                                 ' 获取段落文本并添加手动编号
  30.                                 paragraphText = bulletNumber & ". " & .Text
  31.                                 .Text = paragraphText
  32.                                 
  33.                                 ' 取消自动编号
  34.                                 .ParagraphFormat.Bullet.Type = ppBulletNone
  35.                                 
  36.                                 ' 增加手动编号
  37.                                 bulletNumber = bulletNumber + 1
  38.                             End If
  39.                         End With
  40.                     Next paragraphIndex
  41.                 End If
  42.             End If
  43.         Next shapeIndex
  44.     Next slideIndex
  45. End Sub

复制代码



处理后的文本编号和之前的样式不能对应上,而且没有处理干净,请教一下大神这是什么原因?

处理前:

处理前

处理前


处理后:
002.png





TA的精华主题

TA的得分主题

发表于 2024-10-16 12:10 来自手机 | 显示全部楼层
Sub pptbullet()
    Dim sld As Slide, shp As Shape
    Dim pRng As TextRange: k& = 1
   
    With Application.ActivePresentation
    For Each sld In .Slides
        For Each shp In sld.Shapes
        If shp.Type = msoTextBox Then
            Set pRng = shp.TextFrame.TextRange
            For Each par In pRng.Paragraphs
            With par.ParagraphFormat.Bullet
                If .Type <> 0 Then
                    .Type = 0
                    p = Replace(par.Text, Chr(13), "")
                    par.Text = k & "." & p
                    k = k + 1
                End If
            End With
            Next
        End If
        Next
    Next
    End With
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-10-18 14:36 | 显示全部楼层
本帖最后由 哈哈哈尔 于 2024-10-18 14:39 编辑
lss001 发表于 2024-10-16 12:10
Sub pptbullet()
    Dim sld As Slide, shp As Shape
    Dim pRng As TextRange: k& = 1

感谢回复,但这个代码运行后编号的样式和内容变了

原始ppt内容:
1.png


调整后:

Snipaste_2024-10-18_14-34-18.png

我看了些其它资料貌似要判断之前编号的样式来分析字符编码然后重构一个?

TA的精华主题

TA的得分主题

发表于 2024-10-18 14:43 来自手机 | 显示全部楼层
本帖最后由 lss001 于 2024-10-22 10:48 编辑

楼上代码仅供参考

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-10-18 14:45 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
lss001 发表于 2024-10-18 14:43
您没有提供附件,
楼上代码仅供参考
如有需要应根据实际调整

好,谢谢,我再看看
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-11-21 17:00 , Processed in 0.033648 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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