PPT从每个项目符号的末尾删除点 [英] PPT delete dots from the end of each bullet

问题描述

我正在搜索vba代码，以帮助我们删除"。" PPT幻灯片中每个项目符号行末尾的点。

我在3天前就开始研究并尝试了很多代码和选项但是有些东西丢失了，我无法想象out

这是我正在使用的最后一个代码

子项目符号（）
 Dim sld As Slide 
 Set sld = Application.ActiveWindow.View.Slide 
 Dim pptApp As PowerPoint.Application 
 If ActivePresentation.Slides.Count = 0 Then 
 MsgBox"你没有任何幻灯片你的PowerPoint项目。" 
退出Sub 
结束如果
 Dim shp As Shape 
 Dim paragraph As TextRange 
 For each shp in sld.Shapes 
 If shp.HasTextFrame Then 
如果是shp.TextFrame.HasText那么
如果是shp.TextFrame.TextRange.Paragraphs.Count> 0然后
每个段落在shp.TextFrame.TextRange 
如果shp.TextFrame.TextRange.ParagraphFormat.bullet.Type = ppBulletUnnumbered _ 
和shp.TextFrame.TextRange.ParagraphFormat.bullet.Character = 183 _ 
和shp.TextFrame.TextRange.ParagraphFormat.bullet.font.Name =" symbol" _ 
和shp.TextFrame.TextRange.ParagraphFormat.bullet.font.Color = RGB（255,0,0）然后
而shp.TextFrame.TextRange.Characters（shp.TextFrame.TextRange.Characters。 Count）="。" 
 shp.TextFrame.TextRange.Characters（shp.TextFrame.TextRange.Characters.Count）。删除
 Wend 
结束如果
下一个
结束如果
结束如果
结束如果
下一个
 
结束子

这是有效但仅从最后一行删除点（最后一个项目符号行）

我需要这个来处理每行separatley并删除点，如果它有定义的格式。

提前感谢

解决方案

我找到了这段代码，它和我一起工作

 Sub firstlevelbullet（）
 Dim sld As Slide，shp As Shape，periodgone As Boolean 
 
 For each sld In ActivePresentation.Slides 
 For each shp in sld.Shapes 
 if shp.HasTextFrame = msoTrue Then 
 with shp.TextFrame.TextRange 
 For I = 1 To .Paragraphs.Count 
 periodgone = False 
如果.Paragraphs（I）.ParagraphFormat.bullet = msoT rue _ 
 And .Paragraphs（I）.ParagraphFormat.bullet.Character = 183 _ 
 And .Paragraphs（I）.ParagraphFormat.bullet.font.Name =" symbol" _ 
和.Paragraphs（I）.ParagraphFormat.bullet.font.Color = RGB（255,0,0）然后
 
对于k = .Paragraphs（I）.Characters.Count To 1步-1 
如果不是.Paragraphs（I）。字符（k）.Text = Chr（32）和periodgone = True然后'我们完成了这个段落
退出
结束如果
 If .Paragraphs（I）.Characters（k）.Text = Chr（32）那么
 .Paragraphs（I）.Characters（k）.Delete 
 End if 
如果.Paragraphs（I）.Characters（k）.Text ="。"然后
 .Paragraphs（I）。字符（k）。删除
 periodgone = True 
结束如果
下一个
结束如果
下一个
结束时
结束如果
下一个
下一个
 
结束子

I'm searching for vba code to help us to delete the "." dots from the end of each bulleted line in PPT slide.

I'm working on that 3 days ago and tried a lot of codes and options but there's something missing that I can't figure out

this is the last code I'm using

Sub bullet()
Dim sld As Slide
Set sld = Application.ActiveWindow.View.Slide
Dim pptApp As PowerPoint.Application
  If ActivePresentation.Slides.Count = 0 Then
  MsgBox "You do not have any slides in your PowerPoint project."
  Exit Sub
  End If
Dim shp As Shape
Dim paragraph As TextRange
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
If shp.TextFrame.TextRange.Paragraphs.Count > 0 Then
For Each paragraph In shp.TextFrame.TextRange
If shp.TextFrame.TextRange.ParagraphFormat.bullet.Type = ppBulletUnnumbered _
And shp.TextFrame.TextRange.ParagraphFormat.bullet.Character = 183 _
And shp.TextFrame.TextRange.ParagraphFormat.bullet.font.Name = "symbol" _
And shp.TextFrame.TextRange.ParagraphFormat.bullet.font.Color = RGB(255, 0, 0) Then
While shp.TextFrame.TextRange.Characters(shp.TextFrame.TextRange.Characters.Count) = "."
shp.TextFrame.TextRange.Characters(shp.TextFrame.TextRange.Characters.Count).Delete
Wend
End If
Next
End If
End If
End If
Next
    
End Sub

this is working but deletes the dot from the last line only (last bulleted line)

I need this to work on each line separatley and delete the dot if it's there with the defined formatting.

thanks in advance

解决方案

I found this code and it worked fine with me

Sub firstlevelbullet()
Dim sld As Slide, shp As Shape, periodgone As Boolean
 
For Each sld In ActivePresentation.Slides
   For Each shp In sld.Shapes
      If shp.HasTextFrame = msoTrue Then
         With shp.TextFrame.TextRange
            For I = 1 To .Paragraphs.Count
               periodgone = False
               If .Paragraphs(I).ParagraphFormat.bullet = msoTrue _
And .Paragraphs(I).ParagraphFormat.bullet.Character = 183 _
And .Paragraphs(I).ParagraphFormat.bullet.font.Name = "symbol" _
And .Paragraphs(I).ParagraphFormat.bullet.font.Color = RGB(255, 0, 0) Then

                  For k = .Paragraphs(I).Characters.Count To 1 Step -1
                     If Not .Paragraphs(I).Characters(k).Text = Chr(32) And periodgone = True Then 'we are done with this paragraph
                        Exit For
                     End If
                     If .Paragraphs(I).Characters(k).Text = Chr(32) Then
                        .Paragraphs(I).Characters(k).Delete
                     End If
                     If .Paragraphs(I).Characters(k).Text = "." Then
                        .Paragraphs(I).Characters(k).Delete
                        periodgone = True
                     End If
                  Next
               End If
            Next
         End With
      End If
   Next
Next
 
End Sub

这篇关于PPT从每个项目符号的末尾删除点的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！