如何使用宏和 vba 重命名 PowerPoint 中的部分

How to rename sections in PowerPoint with macro and vba

我正在 VBA 中编写脚本以将幻灯片的标题更改为章节标题。 我想在部分名称中找到 - 并将其更改为 @ 我写了这些代码,但我无法保存更改。

Sub find()
    Dim i As Long

    Dim curName As String
    Dim newName As String

    With ActivePresentation.SectionProperties
        If ActivePresentation.SectionProperties.Count = 0 Then Exit Sub
        For i = 1 To .Count
            curName = .Name(i)
            If Left(curName, 1) = "-" Then
                newName = Replace(curName, "-", "@")
                .Rename(i, newName) = True
            End If
        Next
    End With
End Sub

这里有一些建议:

  • 将过程和变量的名称更改为有意义的名称
  • 缩进代码
  • 如果您使用的是 With 语句,请将其应用于其中的所有代码(如果有此意图)

您的代码问题:

  • 您遗漏了一个 End If(如果您首先缩进了代码,您会注意到)
  • 您必须将此:.Rename(i, newName) = True 更改为:.Rename counter, newName

代码:

Public Sub RenameSections()
    
    Dim counter As Long
    
    Dim currentName As String
    Dim newName As String
    
    With ActivePresentation.SectionProperties
        
        ' If there are no sections, exit procedure
        If .Count = 0 Then Exit Sub
        
        ' Loop through each section
        For counter = 1 To .Count
            ' Store current section's name
            currentName = .Name(counter)
            
            ' Check if character is at section name's begining
            If Left(currentName, 1) = "-" Then
                
                newName = Replace(currentName, "-", "@")
                
                .Rename counter, newName
                
            End If
        Next counter
        
    End With
    
End Sub

如果有效请告诉我

进行改进

Sub ChangeTitlePowerpoint()
Dim curSlide As Slide
For Each curSlide In ActivePresentation.Slides
    curSlide.Shapes.Title.TextFrame.TextRange.Text = Replace(curSlide.Shapes.Title.TextFrame.TextRange.Text, "–", "@k_g@@dluck")
Next curSlide
End Sub

Fonte/Source: https://docs.microsoft.com/

据我所知,在您的代码中有两个阻塞问题:

  1. Rename函数调用错误,你只需要提供两个参数就可以了
.Rename i, newName 
  1. 您只是在寻找第一个字符是否为 -,如果您需要替换与第一个字符等于 - 字符无关的所有内容,您要么需要检查所有或者只是替换所有内容并重命名而不检查第一个字符。

如果我对此处第 2 点的假设是正确的,那么这将是对您的代码进行最小更改的代码:

Sub find()
    Dim i As Long

    Dim curName As String
    Dim newName As String

    With ActivePresentation.SectionProperties
        If ActivePresentation.SectionProperties.Count = 0 Then Exit Sub
        For i = 1 To .Count
            curName = .Name(i)
            newName = Replace(curName, "-", "@")
            .Rename i, newName
        Next
    End With
End Sub

Public 子 RenameSections()

Dim counter As Long

Dim currentName As String
Dim newName As String

With ActivePresentation.SectionProperties
    
    ' If there are no sections, exit procedure
    If .Count = 0 Then Exit Sub
    
    ' Loop through each section
    For counter = 1 To .Count
        ' Store current section's name
        currentName = .Name(counter)
        
        ' Check if character is at section name's begining
        If Left(currentName, 1) = "-" Then
            
            newName = Replace(currentName, "-", "@")
            
            .Rename counter, newName
            
        End If
    Next counter
    
End With

结束子