Удалить разрыв строки в Powerpoint VBA

Я видел этот пост, но не мог изменить свой сценарий VBA для Презентация PPT. Почти на каждом слайде есть текст в текстовом поле. Однако в конце некоторых текстовых полей в конце есть несколько разрывов строки (вводит совпадения), в некоторых местах примерно 1-3. Я хотел бы иметь макрос для удаления этих ненужных разрывов строки. Подскажите, что я здесь делаю не так (2 скрипта):

Sub RemoveSpaces(osh As Shape)

Dim oSl As Slide
    Dim osh As Shape


    With ActivePresentation

For Each oSl In .Slides
    For Each osh In oSl.Shapes
        With osh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    If Right$(osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length, 2)) = vbCrLf Then
                    osh.TextFrame.TextRange.Text = Left$(osh.TextFrame.TextRange.Text, Len(osh.TextFrame.TextRange.Text) - 2)
                    End If
                End If
            End If
        End With
    Next
Next

    End With
End Sub

и

Sub RemoveSpaces()

Dim oSl As Slide
    Dim osh As Shape


    With ActivePresentation

For Each oSl In .Slides
    For Each osh In oSl.Shapes
        With osh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    If osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 2, 2).Text = vbCrLf Then
                    osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 2, 2).Delete
                    End If
                End If
            End If
        End With
    Next
Next

    End With
End Sub

vba string-formatting powerpoint
person Michał Kraska    schedule 08.08.2015    source источник

Ответы (3)


arrow_upward
0
arrow_downward

Когда я нажимаю клавишу ВВОД в PowerPoint, он, по-видимому, добавляет вертикальную вкладку с кодом ASCII 11. Попробуйте следующее:

Sub RemoveSpaces()

Dim oSl As Slide
    Dim osh As Shape


    With ActivePresentation

For Each oSl In .Slides
    For Each osh In oSl.Shapes
        With osh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    Do While osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 1, 1).Text = Chr(11)
                        osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 1, 1).Delete
                    Loop
                End If
            End If
        End With
    Next
Next

    End With
End Sub
person DiegoAndresJAY    schedule 08.08.2015
comment
Почему-то этот скрипт работает только частично. В некоторых местах он удаляет все лишние пробелы, а в других - нет. Когда я копирую текст в непосредственное окно, я вижу, что эти пробелы подписаны «мужским знаком». Может быть, какое-то условие, например, буквенно-цифровое или TRIM (characters.length -1,1) .text =, будет работать? - person Michał Kraska; 10.08.2015

arrow_upward
3
arrow_downward

PowerPoint в этом плане немного странный; окончания строк и абзацев могут различаться в зависимости от имеющейся у вас версии PPT и от того, является ли фигура заполнителем заголовка или каким-либо другим типом фигуры.

У меня есть страница с часто задаваемыми вопросами по PowerPoint, которая, как я утверждаю, объясняет более подробно:

Окончания абзацев и разрывы строк http://www.pptfaq.com/FAQ00992_Paragraph_endings_and_line_breaks.htm

person Steve Rindsberg    schedule 08.08.2015
comment
Я использую PowerPoint 2013. Не уверен, что эта информация актуальна. При приклеивании к окну сразу вижу «мужской знак». Как здесь: stackoverflow.com/questions/4091345/ - person Michał Kraska; 10.08.2015
comment
Информация актуальна. Мужской знак - Chr $ (11). Я обновил страницу часто задаваемых вопросов, чтобы отразить, что информация относится к PPT 2007 и далее. Спасибо за толчок. - person Steve Rindsberg; 10.08.2015

arrow_upward
1
arrow_downward

Это так неприятно, что PPT VBA иногда не может найти разрыв строки / абзаца в текстовом поле. TextRange.Text, TextRange.Runs или даже TextRange.Charaters не помогает нам найти те разрывы, которые являются управляющими символами специального назначения.

В этом случае TextRange.Find - полезный обходной путь, чтобы найти что-то скрытое. Если вы хотите найти и удалить разрывы в текстовом поле, сначала найдите любой Chr (13) в последнем символе в нем, а затем удалите найденный текстовый диапазон, пока он не будет найден. Код выглядит так:

Sub RemoveBreaks()

Dim oSl As Slide
Dim osh As Shape
Dim tr As TextRange

With ActivePresentation

    For Each oSl In ActiveWindow.Selection.SlideRange     '.Slides
        For Each osh In oSl.Shapes
            With osh
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                    
                        With .TextFrame.TextRange
                            Do
                                Set tr = Nothing
                                Set tr = .Find(Chr(13), .Length - 1, 1)
                                If Not tr Is Nothing Then
                                    
                                    Debug.Print "Found <BR> in " & osh.Name & _
                                       " on Slide #" & oSl.SlideIndex
                                    tr.Delete
                                    
                                End If
                            Loop While Not tr Is Nothing
                        End With
                        
                    End If
                End If
            End With
        Next
    Next

End With
End Sub
person konahn    schedule 16.03.2021