Код Powerpoint для сохранения связанных изображений при обмене файлами

Question

В моем Powerpoint есть изображения, которые связаны с папкой.Мне нужно отправить это пользователю, который не имеет доступа к папке.Мне нужны изображения, чтобы сохранить текущий контент.

Я попытался вручную скопировать и повторно вставить изображение как КАК ИЗОБРАЖЕНИЕ, а затем отправить PowerPoint, это работает, и при этом сохраняется настройка содержания и даты в изображениях.

Как я могу программно сделать это, так как у меня 32 PowerPoints?

Answer 1

Для распространения презентации, я думаю, у вас, вероятно, уже есть лучшее решение, но вот другое, которое было бы полезно в некоторых обстоятельствах.

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

Так что если вы хотите распространять связанные изображения, а такжеФайл PowerPoint и может заставить получателя собрать их все вместе в одну папку. Все, что вам нужно сделать, это установить в .LinkFormat.SourceFullName связанного изображения только имя исходного файла изображения, без указания пути.

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

Другой, возможно, самый простой трюк - выбрать Link & Embed, а не просто Link при вставке изображения.Затем PPT обновит изображение в презентации при изменении исходного изображения на диске, но использует встроенную копию, если ссылка не работает.

Answer 2

Это был веселый вызов!

Макрос CopyPictures действительно единственный макрос, который вам нужен, но я включаю два других, которые я использовал для настройки и отладки всей ситуации.

Option Explicit

Sub CopyPictures()

    Dim currentSlide As Slide
    For Each currentSlide In ActivePresentation.Slides

        Dim currentShape As Shape
        For Each currentShape In currentSlide.Shapes

            If currentShape.Type = msoLinkedPicture Then

                'https://docs.microsoft.com/en-us/office/vba/api/powerpoint.shapes.addpicture
                currentSlide.Shapes.AddPicture _
                    currentShape.LinkFormat.SourceFullName, _
                    msoFalse, msoTrue, _
                    currentShape.Left, currentShape.Top, _
                    currentShape.Width, currentShape.Height

                currentShape.Delete

            End If

        Next currentShape

    Next currentSlide

End Sub

Макрос CopyPictures проходит по каждой фигуре на каждом слайде powerpoint и говорит, что если текущая фигура, которую он проверяет, имеет тип msoLinkedPicture, он просто повторно добавит это изображение в powerpointиспользуя ссылку, на которой он основан, но вместо этого выберите изображение для сохранения с документом как msoPicture!Новое изображение размещается в том же месте и масштабируется в соответствии с текущим изображением.Наконец, он удаляет «старую» связанную версию изображения, поскольку она уже была заменена.

---

Макрос AddLinkedPicture использовался для добавления связанной картинки на мой активный слайд, а затем я использовалвторой макрос, ShapeTypeDebug, чтобы убедиться, что картинка, которую я добавил, имела правильный тип, msoLinkedPicture.

Вы можете использовать макрос ShapeTypeDebug, чтобы проверить, является ли какая-либо из фигур на текущем слайде изображением.Я использовал это до и после запуска макроса CopyPictures, чтобы убедиться, что изображения были правильно «преобразованы».

Sub AddLinkedPicture()

    'https://docs.microsoft.com/en-us/office/vba/api/powerpoint.shapes.addpicture
    ActiveWindow.View.Slide.Shapes.AddPicture "C:\Users\Public\Downloads\Untitled.png", msoTrue, msoFalse, 100, 100

End Sub

Sub ShapeTypeDebug()

    Dim currentShape As Shape
    For Each currentShape In ActiveWindow.View.Slide.Shapes

        'https://docs.microsoft.com/en-us/dotnet/api/microsoft.office.core.msoshapetype?view=office-pia
        Select Case currentShape.Type
            Case 11
                MsgBox Chr(34) & currentShape.Name & Chr(34) & " is a msoLinkedPicture"
            Case 13
                MsgBox Chr(34) & currentShape.Name & Chr(34) & " is a msoPicture "
        End Select

    Next currentShape

End Sub

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