OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Export to GIF problem (http://forum.oberonplace.com/showthread.php?t=6025)

norbert_ds 22-08-2008 01:08

Export to GIF problem
 
Hi what I am trying to achieve is to make three differently named GIF files out of my Corel artwork. While the files are created, two of them show up as 0KB.

Would appreciate any help.

Regards
Norbert

Code:

Dim expfltGIF1 As ExportFilter
    Dim expfltGIF2 As ExportFilter
    Dim expfltGIF3 As ExportFilter
    If sx > sy Then
        height = sy * 216 / sx
        Set expfltGIF1 = ActiveDocument.ExportBitmap(FilePth + "Magazine-" + clientID + "_" + Street + "  " + Suburb + "_000_" + RightDigit + ".gif", cdrGIF, cdrAllPages, cdrRGBColorImage, 216, height, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
        Set expfltGIF2 = ActiveDocument.ExportBitmap(FilePth + "Newspaper-" + clientID + "_" + Street + "  " + Suburb + "_000_" + RightDigit + ".gif", cdrGIF, cdrAllPages, cdrRGBColorImage, 216, height, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
        Set expfltGIF3 = ActiveDocument.ExportBitmap(FilePth + "WebSite-" + clientID + "_" + Street + "  " + Suburb + "_000_" + RightDigit + ".gif", cdrGIF, cdrAllPages, cdrRGBColorImage, 216, height, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
    Else
        width = sx * 216 / sy
        Set expfltGIF1 = ActiveDocument.ExportBitmap(FilePth + "Magazine-" + clientID + "_" + Street + "  " + Suburb + "_000_" + RightDigit + ".gif", cdrGIF, cdrAllPages, cdrRGBColorImage, width, 216, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
        Set expfltGIF2 = ActiveDocument.ExportBitmap(FilePth + "Newspaper-" + clientID + "_" + Street + "  " + Suburb + "_000_" + RightDigit + ".gif", cdrGIF, cdrAllPages, cdrRGBColorImage, width, 216, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
        Set expfltGIF3 = ActiveDocument.ExportBitmap(FilePth + "WebSite-" + clientID + "_" + Street + "  " + Suburb + "_000_" + RightDigit + ".gif", cdrGIF, cdrAllPages, cdrRGBColorImage, width, 216, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
    End If
   
    With expfltGIF1
        .Interlaced = True
        .Transparency = 0
        .InvertMask = False
        .ColorIndex = 1
        .Finish
    End With
   
    With expfltGIF2
        .Interlaced = True
        .Transparency = 0
        .InvertMask = False
        .ColorIndex = 1
        .Finish
    End With
   
    With expfltGIF3
        .Interlaced = True
        .Transparency = 0
        .InvertMask = False
        .ColorIndex = 1
        .Finish
    End With


shelbym 29-08-2008 15:18

Sorry....
 
this took so long, school is just killing me. Anyway since all your setting are the same but the name I would write it like this.
Code:

Option Explicit

Sub CreateGIFs()
    Dim sx As Double, sy As Double
    Dim height As Double, width As Double
   
    ActivePage.Shapes.All.GetSize sx, sy
   
    If sx > sy Then
        height = sy * 216 / sx
        CreateGIF "Magazine.gif", width, height
        CreateGIF "Newspaper.gif", width, height
        CreateGIF "WebSite.gif", width, height
    Else
        width = sx * 216 / sy
        CreateGIF "Magazine.gif", width, height
        CreateGIF "Newspaper.gif", width, height
        CreateGIF "WebSite.gif", width, height
    End If
End Sub

Private Sub CreateGIF(ByVal strName As String, ByVal width As Double, ByVal height As Double)
    Const FilePth As String = "c:\temp\gifs\"
    Dim palGIF As New StructPaletteOptions
    Dim expfltGIF As ExportFilter
   
    With palGIF
        .DitherType = cdrDitherNone
        .NumColors = 256
        .PaletteType = cdrPaletteOptimized
        .ColorSensitive = False
    End With
   
    Set expfltGIF = ActiveDocument.ExportBitmap(FilePth + strName, cdrGIF, cdrCurrentPage, cdrPalettedImage, width, 216, 72, 72, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone, palGIF)
   
    With expfltGIF
        .Interlaced = True
        .Transparency = 0
        .InvertMask = False
        .ColorIndex = 1
        .Finish
    End With
   
    Set palGIF = Nothing
    Set expfltGIF = Nothing
End Sub

If in the feature you wish the change other values, just add them to be passed to the Private CreateGIF sub.

Let me know if this doesn't work. I have only tested it under X4

-Shelby


All times are GMT -5. The time now is 06:30.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com