VBA - Bild komprimieren

Code:
Sub MegasellerPicture()

' Vorgehen:

'           - Bilder ins COREL PHOTO-PAINT ziehen

'           - Makro ausführen

' Ergebnis: - Foto in gewünschter Grösse

'           - Kompression eingefügt



' Konstanten (hier können Änderungen gemacht werden)

Const BILDBREITE_k As Integer = 80

Const BILDHOEHE_k As Integer = 0

Const KOMPRESSION_k As Integer = 50



' Variablen

Dim strFileName As String

Dim strPath As String

Dim strJPGFile As String

Dim strText1 As String

Dim strText2 As String

Dim flt As ExportFilter

Dim ad As Document

Dim cs As Object

Dim expflt As ExportFilter 'neu



Set ad = Application.ActiveDocument

Set cs = Application.CorelScript





' Dateiname mit Endung

strFileName = ad.FileName

' Pfadname (ohne Dateinamen)

strPath = ad.FilePath

    ' Bild ms?????_k wird erstellt

    ad.Resample (BILDBREITE_k)

    ' Bild wird exportiert mit der Endung k.jpg (Dateiname bis&mit _ bereits vorhanden)

    strJPGFile = Left(strFileName, InStr(strFileName, "_")) & "k.jpg"

    'Exportieren:

    Set expflt = ad.Export(strJPGFile, cdrJPEG)

    With expflt

        .Progressive = False

        .Optimized = False

        .SubFormat = 0

        .Compression = KOMPRESSION_k

        .Smoothing = 0

        .Finish

    End With

'End If

    

    ' Bild schliessen, damit beim erneuten Klick aufs Makro direkt das nächste Bild bearbeitet wird

    ad.Close

End Sub