Bilder kompriemieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Bilder kompriemieren
von: Igor Gag
Geschrieben am: 17.08.2015 13:46:02

Liebe Forenmitglieder,
ich habe mir über diverse Internetbeispiele folgenden Code zusammengebastelt um per Klick - Bilder per Makro einzufügen und zu löschen. Es gibt 14 Bilder. Hier ein Bps.:

  • 
    Private Sub Image2_Click()
     Dim fd As FileDialog
        Dim Pfad As String
        Dim chosenFile As String
        Pfad = ThisWorkbook.Path & "\Bilder"
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .AllowMultiSelect = False
            .InitialFileName = Pfad
            .Filters.Add "Bilddateien", "*.jpg"
            If .Show = -1 Then
                chosenFile = .SelectedItems(1)
                With Me.Image2
                    .PictureSizeMode = fmPictureSizeModeStretch
                    .Width = 199
                    .Height = 264
                    .Picture = LoadPicture(chosenFile)
                    .PrintObject = True
                End With
            End If
        End With
    End Sub
    Private Sub CommandButton2_Click()
    With Me.Image2
            .Picture = Nothing
            .Width = 30
            .Height = 30
            .PrintObject = False
        End With
    End Sub

  • Mein Problem ist, dass die Datei relativ groß wird obwohl die einzufügenden Bilder nur 256Kb groß sind. Im Vergleich wenn ich die Bilder per Hand einfüge, ist die Datei 3MB groß und per VBA 14Mb.
    Gibt es an dieser Stelle eine Möglichkeit / Code die eingefügten Bilder auch gleichzeitig zu komprimieren?
    Über eine Antwort würde ich mich sehr freuen.
    Vielen Dank
    Igor

    Bild

    Betrifft: AW: Bilder kompriemieren
    von: Rudi Maintaire
    Geschrieben am: 17.08.2015 14:45:12
    Hallo,
    wenn ich die Bilder per Hand einfüge,
    dann fügst du das Bild ein. Mit deinem Code lädst du das Bild in ein Image-Control. Das ist ein rieiger Unterschied.
    Teste mal:

    Sub aaa()
      Dim fd As FileDialog, oImg As Object
      Dim Pfad As String
      Dim chosenFile As String
      Pfad = ThisWorkbook.Path & "\Bilder"
      Set fd = Application.FileDialog(msoFileDialogFilePicker)
      With fd
        .AllowMultiSelect = False
        .InitialFileName = Pfad
        .Filters.Add "Bilddateien", "*.jpg"
        If .Show = -1 Then
          chosenFile = .SelectedItems(1)
          Set oImg = ActiveSheet.Pictures.Insert(chosenFile)
          With oImg
            .Width = 199
            .Height = 264
          End With
        End If
      End With
    End Sub

    Gruß
    Rudi

     Bild

    Beiträge aus den Excel-Beispielen zum Thema "Bilder kompriemieren"