При работе с большими документами, содержащими множество изображений, для повышения эффективности важно оптимизировать размеры файлов. В этой статье блога мы рассмотрим различные методы с использованием VBA (Visual Basic для приложений) для сжатия всех изображений в документе до 150ppi (пикселей на дюйм). Уменьшая разрешение изображения, мы можем значительно уменьшить размер файла без ущерба для визуального качества. Давайте углубимся в несколько примеров кода, чтобы добиться этого.

Метод 1. Использование библиотеки Microsoft Office Interop
Пример кода:

Sub CompressImagesUsingOfficeInterop()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdShape As Object

    ' Initialize Word Application and Document
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Open("C:\Path\To\Your\Document.docx")

    ' Loop through all shapes in the document
    For Each wdShape In wdDoc.Shapes
        ' Check if the shape is an image
        If wdShape.Type = 13 Then
            ' Set the compression options
            wdShape.PictureFormat.Compression = 90
            wdShape.PictureFormat.Resolution = 150
        End If
    Next wdShape

    ' Save and close the document
    wdDoc.Save
    wdDoc.Close

    ' Release objects
    Set wdShape = Nothing
    Set wdDoc = Nothing
    wdApp.Quit
    Set wdApp = Nothing
End Sub

Метод 2: использование Open XML SDK
Пример кода:

Sub CompressImagesUsingOpenXMLSDK()
    Dim docPath As String
    Dim pptDoc As Object
    Dim picPart As Object

    ' Specify the path to your document
    docPath = "C:\Path\To\Your\Document.docx"

    ' Initialize the PowerPoint Document
    Set pptDoc = CreateObject("DocumentFormat.OpenXml.Packaging.PresentationDocument").Open(docPath, True)

    ' Loop through all image parts in the document
    For Each picPart In pptDoc.PresentationPart.GetPartsOfType(Of ImagePart)()
        ' Set the image resolution
        picPart.ImagePart.Image.Width = New IntegerValue(150)
        picPart.ImagePart.Image.Height = New IntegerValue(150)
    Next picPart

    ' Save and close the document
    pptDoc.Save()
    pptDoc.Close()

    ' Release objects
    Set picPart = Nothing
    Set pptDoc = Nothing
End Sub

Метод 3. Использование сторонней библиотеки (например, ImageMagick)
Пример кода:

Sub CompressImagesUsingImageMagick()
    Dim docPath As String
    Dim imagePath As String
    Dim shell As Object

    ' Specify the path to your document
    docPath = "C:\Path\To\Your\Document.docx"

    ' Initialize the shell object
    Set shell = CreateObject("WScript.Shell")

    ' Specify the path to the ImageMagick command-line tool
    shell.Run "magick mogrify -path C:\Path\To\Output -density 150 -quality 90 " & docPath

    ' Release object
    Set shell = Nothing
End Sub

Сжатие изображений в документе до 150 пикселей на дюйм имеет решающее значение для оптимизации размеров файлов без ущерба для визуального качества. В этой статье мы рассмотрели три различных метода использования VBA для достижения этой цели. В первом методе использовалась библиотека взаимодействия Microsoft Office, во втором — Open XML SDK, а в третьем — сторонняя библиотека, например ImageMagick. Используя эти методы, вы сможете эффективно сжимать изображения и повышать производительность ваших документов.