Images, compression, & file size

Hi Folks,

I have an Excel file I am working on with an image box that has click event code to insert a picture. I've been trying to include code to automatically compress the image. The file size gets huge.

The file size is 48 kb, if I insert a 5.0 MB JPEG image the file size jumps to 76 MB!

Generally I compress all images using MSO Picture Manager first to around 100 kb, which minimized the file size expansion, but I'm trying to set up the form so that file compression happens automatically.

One thing I noticed is that if I check the properties of the image box after inserting a JPG, it says the image = (bitmap), which if the jpeg is being converted to a bitmap on insertion it would explain why the file size gets so large (I think).

This is the image insertion code, SheetName and ImageName are public variables:

Private Sub ImageInsert()

' Photo insertion/removal

Dim NewImg, Delimg As Long

Application.ScreenUpdating = False

NewImg = MsgBox("Insert New Photo?", vbYesNoCancel)

    If NewImg = vbYes Then

        Worksheets(SheetName).OLEObjects(ImageName).PrintObject = True

        FileToOpen = Application.GetOpenFilename( _

            "All Files (*.jpg),*.jpg, All Files (*.bmp),*.bmp")

        If FileToOpen <> False Then

            Worksheets(SheetName).OLEObjects(ImageName).Object.Picture _

                = LoadPicture(FileToOpen)

            With Worksheets(SheetName).OLEObjects(ImageName).Object

                .BackColor = &H80000005

                .BorderStyle = fmBorderStyleNone

                .PictureSizeMode = fmPictureSizeModeZoom

                If Val(Application.Version) < 12 Then Run "Module1.CompressPics2003"

                If Val(Application.Version) >= 12 Then Run "Module1.CompressPics2007"

            End With

        End If

    ElseIf NewImg = vbNo Then

        If Worksheets(SheetName).OLEObjects(ImageName). _

                      Object.Picture Is Nothing Then

                      Worksheets(SheetName).OLEObjects(ImageName).PrintObject = False

                      GoTo Skip

            End If

        Delimg = MsgBox("Remove Current Photo?", vbYesNo)

            If Delimg = vbYes Then

                Worksheets(SheetName).OLEObjects(ImageName).Object.Picture = LoadPicture("")

                    With Worksheets(SheetName).OLEObjects(ImageName)

                        .Object.BackColor = &H8000000F

                        .Object.BorderStyle = fmBorderStyleSingle

                        .PrintObject = False

                    End With

            ElseIf Delimg = vbNo Then

            End If

    ElseIf NewImg = vbCancel Then

        End If

Skip:

Application.ScreenUpdating = True

End Sub

These are the subs for image compression:

Private Sub CompressPics2003()

    With Worksheets(SheetName).OLEObjects(ImageName)

        Application.CommandBars.FindControl(ID:=6382).Execute

        SendKeys "%A%W{ENTER}", False

    End With

End Sub

Private Sub CompressPics2007()

    Application.CommandBars.ExecuteMso "PicturesCompress"

End Sub

I realize there is some strange behavior inherent in Excel where OLE objects are concerned, but I'm hoping someone can offer a solution.

Thanks in advance for any help!

Scott