Как удалить изображения, расположенные в определенном месте (например, в правом верхнем углу) из каждого слайда PPT - PullRequest
0 голосов
/ 26 марта 2019

У меня есть много файлов powerpoint, на каждом слайде которых есть изображение в правом верхнем углу.Это не мастер-слайд, а НЕ пользовательская форма макета.

Они были вставлены один за другим во все слайды.

У меня есть несколько приведенных ниже кодов для удаления всех форм (изображений) из слайдов, а как найти фигуры (картинки) в определенном месте слайда?


 For Each Slide In SlideList

    Set sldTemp = ActivePresentation.Slides(Slide)
    For lngCount = sldTemp.Shapes.Count To 1 Step -1
        With sldTemp.Shapes(lngCount)

         '----------Delete All shapes = picture---------- 
            If .Type = msoPicture Then
                .Delete
            End If
        End With
    Next
Next

'-----------------------------------------

Я не очень хорош в VBA для кодирования PowerPoint, любые предложения приветствуются.спасибо.

Ответы [ 2 ]

0 голосов
/ 26 марта 2019

большое спасибо Тиму Уильямсу.

Пилот-коды работают правильно на 3 компьютерах Win10 x86.

кстати, согласно этому высказыванию

По умолчанию размер новой презентации в PowerPoint в настоящее время представляет собой широкоэкранную презентацию, 13,333 дюйма на 7,5 дюйма. В основном у вас будет 96 точек на дюйм (dpi) в настройках экрана, так что это означает, что презентация PowerPoint по умолчанию имеет разрешение 1280 на 720 пикселей.

хотя верхние левые значения, указанные ниже, могут точно соответствовать верхнему правому маленькому логотипу (фигуре) на моем слайде PowerPoint, и те же результаты получаются на 3 разных экранах, один из которых находится в режиме низкой четкости.

Sub DeleteAllTopRightShapes ()

Dim sldTemp As Slide
Dim lngTemp As Long
Dim lngCount As Long

For Each sldTemp In ActivePresentation.Slides
    For lngCount = sldTemp.Shapes.Count To 1 Step -1
        With sldTemp.Shapes(lngCount)



        If .Type = msoPicture Then
          If .Top >= 0 And .Top < 60 And .Left >= 400 Then

            .Delete

          End If
        End If

        End With
    Next
Next
    MsgBox "Process complete!"

End Sub

0 голосов
/ 26 марта 2019

Вы можете проверить положение, посмотрев на свойства Top и Left. Вы также можете проверить размер, если они все одинакового размера.

Например:

 If .Type = msoPicture Then
     If .Top > x and .Top < y and .Left > a and .Left < b Then 
       .Delete
       Exit For
     End If
 End If

Где x, y, a и b - переменные или жестко заданные значения.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...