OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 22-08-2008, 01:08
norbert_ds
Guest
 
Posts: n/a
Default 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
Reply With Quote
  #2  
Old 29-08-2008, 15:18
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default 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
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Using Macros to Export to Gif and/or EPS jfelder Macros/Add-ons 5 11-04-2008 11:33
HPGL export problem Anonymous General 1 16-02-2006 09:15
Problem with Export (or Save as) in AI-Format LOT CorelDRAW/Corel DESIGNER VBA 3 10-02-2004 14:28
Corel is putting a border when I export in GIF format Nicky CorelDRAW/Corel DESIGNER VBA 2 02-02-2004 23:26
Example for Gif Export adriano Corel Photo-Paint VBA 1 10-04-2003 20:03


All times are GMT -5. The time now is 03:17.


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