Export Problem

[knowbodynow]

I have a file with 106 pages size around 25 mb. I have a 374 dpi bitmap on one page. When I export the single page using the following code the save file is over 1 GB for X5 format and 95 mb for X6! I'm Using X6 without any service packs:

Private Sub cmdOK_Click()

    Dim Activate As Boolean

    Activate = False

    For i = 0 To ListToExp.ListCount - 1
    If ListToExp.Selected(i) = True Then
        Activate = True
        Exit For
    End If
    Next i
    
    If Activate = False Then MsgBox "Select at least one layer", vbExclamation, "Oops! - Nothing to Export": Exit Sub

    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.Resolution = 300
   

    Dim sp As Integer, ep As Integer, pags As Integer
    Dim sr As ShapeRange
    Dim opt As New StructSaveAsOptions
    Dim expfltCDR As ExportFilter
    Dim wid As Long, hgt As Long, strnos As Long
    Dim Range As Double
    Dim ts As Shape

    Range = pageT.Value - pageB.Value

    If pageT.Value > ActiveDocument.pages.Count Or Range < 0 Or pageB.Value < 1 Then
    MsgBox "Oops!", vbExclamation, "Check your page ranges!"
    Exit Sub
    End If
          
    Optimization = True

    pags = sp

    For pags = pageB To pageT

        ActiveDocument.ClearSelection
        ActiveDocument.pages(pags).Activate

        For i = 0 To ListToExp.ListCount - 1
        If ListToExp.Selected(i) = True Then
            nam = ListToExp.list(i)
            ActiveDocument.pages(pags).Layers(nam).Shapes.All.AddToSelection
            ActiveDocument.pages(pags).Layers(nam).Printable = True
            ActiveDocument.pages(pags).Layers(nam).Activate
        End If
        Next i

        If ActiveSelection.Shapes.Count > 0 Then
        
            Set sr = ActiveSelection.DuplicateAsRange
                       
            Set sr = ActiveSelectionRange
            
            sr.Group
            
            sr.AlignRangeToPage cdrAlignHCenter
            sr.AlignRangeToPage cdrAlignVCenter

            FilePth = cmdPath.Caption
            strName = ActiveDocument.pages(pags).name
            
            
            If TrimName Then
            
                strnos = InStrRev(strName, " ")
                If strnos > 0 Then strName = Mid(strName, strnos, Len(strName))
                
            End If
            
            If SaveAsX5.Value = True Then
            
                With opt
                    .EmbedVBAProject = False
                    .Filter = cdrCDR
                    .IncludeCMXData = True
                    .Range = cdrSelection
                    .EmbedICCProfile = False
                    .ThumbnailSize = cdr10KColorThumbnail
                    .Version = cdrVersion15
                    .Overwrite = True
                End With
                
            Else
            
                With opt
                    .EmbedVBAProject = False
                    .Filter = cdrCDR
                    .IncludeCMXData = True
                    .Range = cdrSelection
                    .EmbedICCProfile = False
                    .ThumbnailSize = cdr10KColorThumbnail
                    .Version = cdrCurrentVersion
                    .Overwrite = True
                End With
            
            End If
            
            FilePth = FilePth & "\" & strName & ".cdr"
            FilePth = Replace(FilePth, "\\", "\")
            ActiveDocument.SaveAs FilePth, opt
            
           sr.Delete

        End If

    Next pags

    Optimization = False
    
    cmdClose_Click

End Sub

Without the bitmap the file saves as 43 kb as an X6 file and 10 times that as an X5 file. Can anyone tell me why having the bitmap causes the file size to balloon? What can I do to keep the file size down? Thanks