Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Batch ImageConverter CMX >>>>> CDR

Status
Not open for further replies.
funky64dude

funky64dude

Technical User
Joined
Mar 9, 2006
Messages
33
Location
NL
Hi there,

I have got a load of CMX vector files, categorized in several folders. My intention is to convert them to CDR vector files.
I have tried to do that with the image converter in CorelDRAW X3. This (Visual Basic 6.3) converter works fine and I can batch process the whole content of a single folder.
No problem so far.
But this converter saves the CDR files as version 13 and I want CDR files as version 10. In the File Converter window I cannot choose the version number.

In CorelDRAW it is possible to real-time record a macro.
I did this in the following steps:
Visual Basic: Record, open a CMX file, save as CDR version 10, close, stop macro. But when I run this script only that CMX file will be converted, nothing more.
I see here some recognition with the scripting in Photoshop. But if I want to run a script in Photoshop I can choose the 'read' and 'save' folder. It would be great that these options are also available in this macro.

So my question is:
Is it possible to make a macro that batch converts CMX files to CDR files (version 5, 6, 7, 8, 9 or 10)? The convert party is compleet if a whole directory structure can be converted.

I really have no idea if this can be done in VisualBasic.
Visual Basic is quite new to me.

Greetz,
Funky
 
Sort by date Sort by votes
I can batch process the whole content of a single folder
Which code ?
when I run this script only that CMX file will be converted
Which code ?

Can't you merge the 2 ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Upvote 0 Downvote
Thnx for the reply.

Your questions give me questions.
What do you mean with 'Which code'?
'Can't you merge the 2'?

Like I said, VB is quite new to me.
I'm a DTP'er (not a VB coder) who wants to create CDR files from CMX files in batch.
I know it can be done. But how?

I don't know if you are familiar to CorelDRAW and his VB option. I sniffed a bit at DRAW. DRAW has a Visual Basic editor on board.
Is VB universal enough to import to DRAW?


What information do you want?

Funky
 
Upvote 0 Downvote
Here is some additional info.

I imported the custom step-by-step macro I made real time in the VB editor. This script actually opens a CMX file, saves as CDR version 10 (with some additional save options) and closes.
Below you see what I found.
Maybe this wil help.
Funky





Sub CMX_to_CDR_10()
'
' Recorded 24-3-2007
'
' Description:
' This script converts a CMX file to CDR(v.10)
'
ActiveDocument.Pages(1).Activate
ActivePage.Layers("Dummy%Layer%Dummy%Layer").Activate
ActiveLayer.Name = "Dummy%Layer%Dummy%Layer"
Dim s1 As Shape
' Recording of this command is not supported
Dim impflt As ImportFilter
Dim impopt As StructImportOptions
Set impopt = New StructImportOptions
impopt.MaintainLayers = True
Set impflt = ActiveLayer.ImportEx("D:\APPLE_SHARE\TEMP cmx-files\BIRTH01.CMX", cdrCMX6, impopt)
impflt.Finish
Set s1 = ActiveShape
ActiveLayer.Delete
Dim grp1 As ShapeRange
Set grp1 = s1.UngroupEx
Dim doc1 As Document
Set doc1 = OpenDocument("D:\APPLE_SHARE\TEMP cmx-files\BIRTH01.cmx")
Dim SaveOptions As StructSaveAsOptions
Set SaveOptions = New StructSaveAsOptions
With SaveOptions
.EmbedVBAProject = False
.Filter = cdrCDR
.IncludeCMXData = False
.Range = cdrAllPages
.EmbedICCProfile = False
.ThumbnailSize = cdrNoThumbnail
.Version = cdrVersion10
End With
doc1.SaveAs "D:\APPLE_SHARE\TEMP cmx-files\BIRTH01.cdr", SaveOptions
doc1.Close
End Sub
 
Upvote 0 Downvote
Perhaps something like this ?
Code: 
Sub CMX2CDR10()
  Dim strDir As String, strDoc As String
  Dim doc1 As Document
  Dim SaveOptions As StructSaveAsOptions
  Set SaveOptions = New StructSaveAsOptions
  With SaveOptions
    .EmbedVBAProject = False
    .Filter = cdrCDR
    .IncludeCMXData = False
    .Range = cdrAllPages
    .EmbedICCProfile = False
    .ThumbnailSize = cdrNoThumbnail
    .Version = cdrVersion10
  End With
  strDir = "D:\APPLE_SHARE\TEMP cmx-files\"
  strDoc = Dir(strDir & "*.cmx")
  While strDoc <> ""
    Set doc1 = OpenDocument(strDir & strDoc)
    doc1.SaveAs strDir & Replace(strDoc, ".cmx", ".cdr", 1), SaveOptions
    doc1.Close
    strDoc = Dir()
  WEnd
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Upvote 0 Downvote
Thnx for the effort.

When I start your macro nothing happens.

When I activate the built-in file converter of DRAW a window opens where I can select the 'read' and 'save' folder, what file type and some other file related options.
Below the code (without the ----):
-------------------------
Option Explicit

Sub Start()
frmFileConverter.Show
End Sub
---------------------------

When I look into the Forms folder I see indeed the used window, when I click at frmFileConverter.show
When I rightclick on that window in the editor a really long list of code appears.
I hope that's no problem for you if I copy and past that below.
I cannot find the section in this code of the filetypes and-version. Note that in this converter I cannot change the version number of an exported CDR file. But in a normal 'Save as' in Draw I can select that.

If it's too much for you just say it.

Thnx in advance,
Funky




Option Explicit

Private PaperTypes As Collection

Private Const COLOR_BW = "B & W"
Private Const COLOR_RGB = "RGB"
Private Const COLOR_PAL = "Paletted"
Private Const COLOR_CMYK = "CMYK"
Private Const COLOR_GRAY = "Grayscale"
Private Const COLOR_16 = "16 Colors"

Private Const DRAW_MAX_PAGE_SIZE = 1800

Private Const INCHES_TO_MILLIMETERS = 25.4

Private Const DEFAULT_DPI = 96

Private PageAsSeparateFile As Boolean
Private ApplyColorProfile As Boolean
Private UseBackgroundColor As Boolean
Private UsePage As Boolean
Private MaintainAspectRatio As Boolean
Private AntiAliasing As Boolean
Private UseImageWidth As Boolean
Private UseImageHeight As Boolean
Private UseResolution As Boolean
Private LastUsedColorMode As String
Private IsEditing As Boolean
Private BackGroundColor As Color

Private AIOptions As New AIExportOptions
Private DXFOptions As New DXFExportOptions
Private WMFOptions As New WMFExportOptions
Private WPGOptions As New WPGExportOptions
Private EPSOptions As New EPSExportOptions
Private JPGOptions As New JPGExportOptions
Private GIFOptions As New GIFExportOptions
Private BMPOptions As New BMPExportOptions
Private TIFOptions As New TIFExportOptions
Private PNGOptions As New PNGExportOptions

Private PALOptions As New PaletteOptions

Private Sub cboColorModes_Change()
If IsEditing = False Then
If IsRaster(cboFileFormat.Text) Then LastUsedColorMode = cboColorModes.Text
End If
cmdPalette.Enabled = (cboColorModes.Text = COLOR_PAL)
End Sub

Private Sub cboFileFormat_Change()
Dim b As Boolean
cmdAdvanced.Enabled = HasAdvancedOptions(cboFileFormat.Text)
b = IsRaster(cboFileFormat.Text)
ToggleBitmapControls b
If b Then InitColorModes cboFileFormat.Text, cboColorModes
End Sub

Private Sub cboPageSize_Change()
UpdatePageInfo cboPageSize.ListIndex
End Sub

Private Sub chkAntiAliasing_Click()
AntiAliasing = chkAntiAliasing.Value
End Sub

Private Sub chkAspectRatio_Click()
MaintainAspectRatio = chkAspectRatio.Value
End Sub

Private Sub chkBackgroundColor_Click()
UseBackgroundColor = chkBackgroundColor.Value
cmdBackgroundColor.Enabled = UseBackgroundColor
End Sub

Private Sub chkImageHeight_Click()
ToggleTextControl txtImageHeight, chkImageHeight.Value, chkImageHeight.Value
spnImageHeight.Enabled = chkImageHeight.Value
UseImageHeight = chkImageHeight.Value
chkAspectRatio.Enabled = (chkImageWidth.Value = True And chkImageHeight.Value = True)
End Sub

Private Sub chkImageWidth_Click()
ToggleTextControl txtImageWidth, chkImageWidth.Value, chkImageWidth.Value
spnImageWidth.Enabled = chkImageWidth.Value
UseImageWidth = chkImageWidth.Value
chkAspectRatio.Enabled = (chkImageWidth.Value = True And chkImageHeight.Value = True)
End Sub

Private Sub chkPageProperties_Click()
UsePage = chkPageProperties.Value
TogglePageSizeControls (chkPageProperties.Value)
End Sub

Private Sub chkResolution_Click()
ToggleTextControl txtResolution, chkResolution.Value, chkResolution.Value
spnResolution.Enabled = chkResolution.Value
UseResolution = chkResolution.Value
End Sub

Private Sub chkSeparateFile_Click()
PageAsSeparateFile = chkSeparateFile.Value
End Sub

Private Sub ckApplyColorProfile_Click()
ApplyColorProfile = ckApplyColorProfile.Value <> 0
End Sub

Private Sub cmdAdvanced_Click()
ShowAdvancedDialog cboFileFormat.Text
End Sub

Private Sub cmdBackgroundColor_Click()
Dim c As New Color
Dim b As Boolean
With c
.CMYKAssign 0, 0, 0, 0
b = .UserAssignEx
If b Then
BackGroundColor.CopyAssign c
If .Type <> cdrColorRGB Then .ConvertToRGB
cmdBackgroundColor.BackColor = RGB(.RGBRed, .RGBGreen, .RGBBlue)
End If
End With
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdDestination_Click()
Dim Folder As String
Folder = BrowseForFolderDlg(txtDestination.Text, "Select Destination Folder", _
GetWindowHandle("ThunderDFrame", Me.Caption))
If Folder <> "" Then
txtDestination.Text = Folder
End If
End Sub

Private Sub cmdOK_Click()
If ValidateDir(txtSource.Text) And ValidateDir(txtDestination.Text) Then
ConvertFiles
Else
MsgBox "Invalid Source or Destination folder", vbOKOnly, "Invalid Folder"
End If
End Sub
Private Sub cmdPalette_Click()
frmPaletteOptions.Show
PALOptions.GetProperties frmPaletteOptions
End Sub
Private Sub cmdSource_Click()
frmSourceSelection.Show
End Sub

Private Sub spnHeight_SpinDown()
txtPageHeight.Text = Trim$(str$(Val(txtPageHeight.Text) - 0.5))
End Sub

Private Sub spnHeight_SpinUp()
txtPageHeight.Text = Trim$(str$(Val(txtPageHeight.Text) + 0.5))
End Sub

Private Sub spnImageHeight_SpinDown()
txtImageHeight.Text = Trim$(str$(Val(txtImageHeight.Text) - 1))
End Sub

Private Sub spnImageHeight_SpinUp()
txtImageHeight.Text = Trim$(str$(Val(txtImageHeight.Text) + 1))
End Sub

Private Sub spnImageWidth_SpinDown()
txtImageWidth.Text = Trim$(str$(Val(txtImageWidth.Text) - 1))
End Sub

Private Sub spnImageWidth_SpinUp()
txtImageWidth.Text = Trim$(str$(Val(txtImageWidth.Text) + 1))
End Sub

Private Sub spnResolution_SpinDown()
txtResolution.Text = Trim$(str$(Val(txtResolution.Text) - 1))
End Sub

Private Sub spnResolution_SpinUp()
txtResolution.Text = Trim$(str$(Val(txtResolution.Text) + 1))
End Sub

Private Sub spnWidth_SpinDown()
txtPageWidth.Text = Trim$(str$(Val(txtPageWidth.Text) - 0.5))
End Sub

Private Sub spnWidth_SpinUp()
txtPageWidth.Text = Trim$(str$(Val(txtPageWidth.Text) + 0.5))
End Sub

Private Sub txtPageHeight_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If cboUnits.Value = "Inches" Then
If Val(txtPageHeight.Text) > DRAW_MAX_PAGE_SIZE Then
txtPageHeight.Text = Trim$(str$(DRAW_MAX_PAGE_SIZE))
End If
Else
If Val(txtPageHeight.Text) > DRAW_MAX_PAGE_SIZE * INCHES_TO_MILLIMETERS Then
txtPageHeight.Text = Trim$(str$(DRAW_MAX_PAGE_SIZE * INCHES_TO_MILLIMETERS))
End If
End If
End Sub

Private Sub txtPageWidth_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If cboUnits.Value = "Inches" Then
If Val(txtPageWidth.Text) > DRAW_MAX_PAGE_SIZE Then
txtPageWidth.Text = Trim$(str$(DRAW_MAX_PAGE_SIZE))
End If
Else
If Val(txtPageWidth.Text) > DRAW_MAX_PAGE_SIZE * INCHES_TO_MILLIMETERS Then
txtPageWidth.Text = Trim$(str$(DRAW_MAX_PAGE_SIZE * INCHES_TO_MILLIMETERS))
End If
End If
End Sub

Private Sub UserForm_Initialize()
InitUnitsCombo
InitPageSizeCombo
InitFileTypeCombo cboFileFormat
InitBackGroundColor
cmdBackgroundColor.BackColor = RGB(255, 255, 255)
End Sub

Private Sub AddPaperType(Name As String, Width As Double, Height As Double, Metric As Boolean)
Dim p As New clsPaperSize
Dim v As Double
v = 1
p.Name = Name
p.IsMetric = Metric
If Not Metric Then v = INCHES_TO_MILLIMETERS
p.Width = Width * v
p.Height = Height * v
PaperTypes.Add p
End Sub

Private Sub InitPageSizeCombo()
Dim p As clsPaperSize
Set PaperTypes = New Collection
AddPaperType "Letter", 8.5, 11, False
AddPaperType "Legal", 8.5, 14, False
AddPaperType "Tabloid", 11, 17, False
AddPaperType "Statement/Half", 5.5, 8.5, False
AddPaperType "Executive", 7.25, 10.5, False
AddPaperType "Broad Sheet", 18, 24, False
AddPaperType "A1", 594, 841, True
AddPaperType "A2", 420, 594, True
AddPaperType "A3", 297, 420, True
AddPaperType "A4", 210, 297, True
AddPaperType "A5", 148, 210, True
AddPaperType "A6", 105, 148, True
AddPaperType "Custom", 0, 0, True
cboPageSize.Clear
For Each p In PaperTypes
cboPageSize.AddItem p.Name
Next p
cboPageSize.ListIndex = 0
End Sub

Private Sub InitUnitsCombo()
With cboUnits
.AddItem "Inches"
.AddItem "Millimeters"
.ListIndex = 0
End With
End Sub
'fills the color modes combo based upon the file format
Private Sub InitColorModes(Format As String, cb As ComboBox)
Dim i As Integer
IsEditing = True
cb.Clear
Select Case Format
Case BMP_FILE, PNG_FILE
With cb
.AddItem COLOR_BW
.AddItem COLOR_16
.AddItem COLOR_GRAY
.AddItem COLOR_PAL
.AddItem COLOR_RGB
If LastUsedColorMode <> "" Then
i = FindItemInCombo(LastUsedColorMode, cb)
If i > -1 Then
.ListIndex = i
Else
.ListIndex = 4
End If
Else
.ListIndex = 4
End If
End With
Case TIF_FILE, CPT_FILE, PPF_FILE
With cb
.AddItem COLOR_BW
.AddItem COLOR_16
.AddItem COLOR_GRAY
.AddItem COLOR_PAL
.AddItem COLOR_RGB
.AddItem COLOR_CMYK
If LastUsedColorMode <> "" Then
i = FindItemInCombo(LastUsedColorMode, cb)
If i > -1 Then
.ListIndex = i
Else
.ListIndex = 4
End If
Else
.ListIndex = 4
End If
End With
Case JPG_FILE
With cb
.AddItem COLOR_GRAY
.AddItem COLOR_PAL
.AddItem COLOR_RGB
.AddItem COLOR_CMYK
If LastUsedColorMode <> "" Then
i = FindItemInCombo(LastUsedColorMode, cb)
If i > -1 Then
.ListIndex = i
Else
.ListIndex = 2
End If
Else
.ListIndex = 2
End If
End With
Case GIF_FILE
With cb
.AddItem COLOR_BW
.AddItem COLOR_16
.AddItem COLOR_GRAY
.AddItem COLOR_PAL
If LastUsedColorMode <> "" Then
i = FindItemInCombo(LastUsedColorMode, cb)
If i > -1 Then
.ListIndex = i
Else
.ListIndex = 3
End If
Else
.ListIndex = 3
End If
End With
Case Else
End Select
IsEditing = False
End Sub

Private Sub InitBackGroundColor()
Set BackGroundColor = New Color
BackGroundColor.CMYKAssign 0, 0, 0, 0
End Sub
Private Function HasAdvancedOptions(Format As String) As Boolean
Select Case Format
Case CMX_FILE, CDR_FILE, CGM_FILE, PCT_FILE, SWF_FILE, DES_FILE
Case SVG_FILE, PPF_FILE, CPT_FILE
HasAdvancedOptions = False
Case Else
HasAdvancedOptions = True
End Select
End Function
'inputs the the page size based on the page name
Private Sub UpdatePageInfo(idx As Long)
Dim p As clsPaperSize
Dim Metric As Boolean

If idx < 0 Or idx = PaperTypes.Count - 1 Then Exit Sub
Set p = PaperTypes(idx + 1)
If Not p.IsMetric Then
cboUnits.ListIndex = 0
txtPageWidth.Text = Trim$(str$(p.Width / INCHES_TO_MILLIMETERS)) 'convert to inches
txtPageHeight.Text = Trim$(str$(p.Height / INCHES_TO_MILLIMETERS))
Else
cboUnits.ListIndex = 1
txtPageWidth.Text = Trim$(str$(p.Width))
txtPageHeight.Text = Trim$(str$(p.Height))
End If
End Sub
'displays the filter's export dialog
Private Function ShowAdvancedDialog(Format As String) As Boolean
Dim d As Document
Dim eFlt As ExportFilter
Dim se As StructExportOptions
Dim NewDocCreated As Boolean

Select Case Format
Case AI_FILE
Set d = CreateDocument
NewDocCreated = True
'so that we have something on the page.....
CreateShape d
Set eFlt = d.ExportEx("c:\test.ai", cdrAI)
If AIOptions.Initialized Then
AIOptions.SetProperties eFlt
End If
If eFlt.ShowDialog Then
AIOptions.GetProperties eFlt
End If
Case DXF_FILE
Set d = CreateDocument
NewDocCreated = True
'so that we have something on the page.....
CreateShape d
Set eFlt = d.ExportEx("c:\test.DXF", cdrDXF)
If DXFOptions.Initialized Then
DXFOptions.SetProperties eFlt
End If
If eFlt.ShowDialog Then
DXFOptions.GetProperties eFlt
End If
Case WMF_FILE
Set d = CreateDocument
NewDocCreated = True
'so that we have something on the page.....
CreateShape d
Set eFlt = d.ExportEx("c:\test.WMF", cdrWMF)
If WMFOptions.Initialized Then
WMFOptions.SetProperties eFlt
End If
If eFlt.ShowDialog Then
WMFOptions.GetProperties eFlt
End If
Case WPG_FILE
Set d = CreateDocument
NewDocCreated = True
'so that we have something on the page.....
CreateShape d
Set eFlt = d.ExportEx("c:\test.WPG", cdrWPG)
If WPGOptions.Initialized Then
WPGOptions.SetProperties eFlt
End If
If eFlt.ShowDialog Then
WPGOptions.GetProperties eFlt
End If
Case EPS_FILE
Set d = CreateDocument
NewDocCreated = True
'so that we have something on the page.....
CreateShape d
Set eFlt = d.ExportEx("c:\test.eps", cdrEPS)
If EPSOptions.Initialized Then
EPSOptions.SetProperties eFlt
End If
If eFlt.ShowDialog Then
EPSOptions.GetProperties eFlt
End If
Case BMP_FILE
NewDocCreated = False
With frmBMPOptions
If BMPOptions.Initialized Then
.Compression = BMPOptions.SetProperties.Compression
End If
.Show
If .Initialized Then
BMPOptions.GetProperties frmBMPOptions.Compression
End If
End With
Case JPG_FILE
Set d = CreateDocument
NewDocCreated = True
'so that we have something on the page.....
CreateShape d
'we need to use a valid filename eventhough we are not going to export now
Set eFlt = d.ExportEx("c:\test.jpg", cdrJPEG)
If JPGOptions.Initialized Then
JPGOptions.SetProperties eFlt
End If
If eFlt.ShowDialog Then
JPGOptions.GetProperties eFlt
End If
Case TIF_FILE
NewDocCreated = False
With frmTIFOptions
If TIFOptions.Initialized Then
Set se = TIFOptions.SetProperties
.Compression = se.Compression
.Transparent = se.Transparent
End If
.Show
If .Initialized Then
TIFOptions.GetProperties frmTIFOptions.Compression, frmTIFOptions.Transparent
End If
End With
Case PNG_FILE
NewDocCreated = False
With frmPNGOptions
If PNGOptions.Initialized Then
PNGOptions.SetFormProperties frmPNGOptions
End If
.Show
If .Initialized Then
PNGOptions.GetFormProperties frmPNGOptions
End If
End With
Case GIF_FILE
NewDocCreated = False
With frmGIFOptions
If GIFOptions.Initialized Then
GIFOptions.SetFormProperties frmGIFOptions
End If
.Show
If .Initialized Then
GIFOptions.GetFormProperties frmGIFOptions
End If
End With
Case Else
End Select
If NewDocCreated Then
d.Dirty = False
d.Close
End If
End Function

Private Function IsRaster(Format As String) As Boolean
Select Case Format
Case BMP_FILE, GIF_FILE, JPG_FILE, PNG_FILE, TIF_FILE, CPT_FILE, PPF_FILE
IsRaster = True
Case Else
IsRaster = False
End Select
End Function
'converts files using the current settings
Private Sub ConvertFiles()
Dim n As Integer
Dim d As Document
Dim ex As ExportFilter
Dim SourceDir As String
Dim flt As cdrFilter
Dim DestDir As String
Dim p As Page
Dim se As StructExportOptions
Dim si As New StructImportOptions
Dim pal As StructPaletteOptions
Dim nStage As Long
Dim CurFileName As String, Ret As VbMsgBoxResult

Set d = Nothing
nStage = 0 ' Out of file conversion loop
On Error GoTo ErrHandler
Me.MousePointer = fmMousePointerHourGlass
If IsRaster(cboFileFormat.Text) Then
Set se = GetStructExport(cboFileFormat.Text)
Set pal = PALOptions.SetProperties
Else
Set se = CreateStructExportOptions
End If
se.UseColorProfile = ApplyColorProfile
SourceDir = txtSource.Text
DestDir = txtDestination.Text
si.CombineMultilayerBitmaps = True
si.MaintainLayers = True
flt = GetFilterType(cboFileFormat.Text)
'append a backslash if there isn't already one
If Right$(SourceDir, 1) <> "\" Then SourceDir = SourceDir & "\"
If Right$(DestDir, 1) <> "\" Then DestDir = DestDir & "\"
For n = 0 To frmSourceSelection.lstSelectedFiles.ListCount - 1
nStage = 1 ' Opening a file
Set d = Nothing
CurFileName = SourceDir & frmSourceSelection.lstSelectedFiles.List(n)
If PageAsSeparateFile And UCase$(Right$(CurFileName, 4)) = ".CDR" Then
Set d = OpenDocument(CurFileName)
Else
Set d = CreateDocument
d.ActiveLayer.Import CurFileName, , si
End If

If UseBackgroundColor Then
SetBackgroundColor
End If

If d.Pages.Count > 1 Or d.Selection.Shapes.Count > 0 Then
nStage = 2 ' Processing the file
'set the page size
If UsePage Then
If cboUnits.ListIndex = 0 Then
d.Pages(0).SetSize Val(txtPageHeight.Text), Val(txtPageWidth.Text)
Else
d.Pages(0).SetSize Val(txtPageHeight.Text / INCHES_TO_MILLIMETERS), Val(txtPageWidth.Text / INCHES_TO_MILLIMETERS)
End If
End If

nStage = 3 ' Saving the file
'export the file
If cboFileFormat.Text <> CDR_FILE And cboFileFormat.Text <> DES_FILE Then
If PageAsSeparateFile Then
For Each p In d.Pages
CurFileName = GetNewFileName(frmSourceSelection.lstSelectedFiles.List(n), cboFileFormat.Text, DestDir, p.Index)
p.Activate
Set ex = d.ExportEx(CurFileName, flt, cdrCurrentPage, se, pal)
GetExportOptions cboFileFormat.Text, ex
ex.Finish
Set ex = Nothing
Next p
Else
CurFileName = GetNewFileName(frmSourceSelection.lstSelectedFiles.List(n), cboFileFormat.Text, DestDir)
Set ex = d.ExportEx(CurFileName, flt, cdrCurrentPage, se, pal)
GetExportOptions cboFileFormat.Text, ex
ex.Finish
Set ex = Nothing
End If
Else
If PageAsSeparateFile Then
For Each p In d.Pages
CurFileName = GetNewFileName(frmSourceSelection.lstSelectedFiles.List(n), cboFileFormat.Text, DestDir, p.Index)
p.Activate
d.SaveAs CurFileName
Next p
Else
CurFileName = GetNewFileName(frmSourceSelection.lstSelectedFiles.List(n), cboFileFormat.Text, DestDir)
d.SaveAs CurFileName
End If
End If
End If
NextFile1:
nStage = 4 ' Closing the file
If Not d Is Nothing Then
d.Dirty = False 'set the dirty flag and ...
d.Close 'close the doc
Set d = Nothing
End If
NextFile2:
Next n
ExitSub:
If Not d Is Nothing Then
d.Dirty = False 'set the dirty flag and ...
d.Close 'close the doc
Set d = Nothing
End If
Me.MousePointer = fmMousePointerDefault
Exit Sub
ErrHandler:
Select Case nStage
Case 1 ' Open
Ret = MsgBox("Unable to open the file '" & CurFileName & "'" & vbCr & Err.Description, vbCritical + vbAbortRetryIgnore)
If Ret = vbAbort Then Resume ExitSub
If Ret = vbRetry Then Resume
If Ret = vbIgnore Then Resume NextFile1
Case 2 ' Processing
Ret = MsgBox("Error processing the file '" & CurFileName & "'" & vbCr & Err.Description, vbCritical + vbAbortRetryIgnore)
If Ret = vbAbort Then Resume ExitSub
If Ret = vbRetry Then Resume
If Ret = vbIgnore Then Resume NextFile1
Case 3 ' Saving
Ret = MsgBox("Error saving the file '" & CurFileName & "'" & vbCr & Err.Description, vbCritical + vbAbortRetryIgnore)
If Ret = vbAbort Then Resume ExitSub
If Ret = vbRetry Then Resume
If Ret = vbIgnore Then Resume NextFile1
Case 4 ' Closing
Ret = MsgBox("Error occured while trying to close a document" & vbCr & Err.Description, vbCritical + vbAbortRetryIgnore)
If Ret = vbAbort Then Resume ExitSub
If Ret = vbRetry Then Resume
If Ret = vbIgnore Then Resume NextFile2
Case Else
MsgBox "Unexpected error occured" & vbCr & Err.Description, vbCritical
Resume ExitSub
End Select
End Sub
'sets the page color
Private Sub SetBackgroundColor()
Dim p As Page

For Each p In ActiveDocument.Pages
p.Background = cdrPageBackgroundSolid
p.Color = BackGroundColor
Next p
End Sub

Private Function GetFilterType(Format As String) As cdrFilter
Select Case Format
Case CMX_FILE
GetFilterType = cdrCMX6
Case CDR_FILE
GetFilterType = cdrCDR
Case DES_FILE
GetFilterType = cdrDES
Case EPS_FILE
GetFilterType = cdrEPS
Case AI_FILE
GetFilterType = cdrAI
Case WPG_FILE
GetFilterType = cdrWPG
Case WMF_FILE
GetFilterType = cdrWMF
Case CGM_FILE
GetFilterType = cdrCGM
Case PCT_FILE
GetFilterType = 1293
Case SWF_FILE
GetFilterType = cdrSWF
Case SVG_FILE
GetFilterType = cdrSVG
Case DSF_FILE
GetFilterType = cdrDSF
Case DXF_FILE
GetFilterType = cdrDXF
Case BMP_FILE
GetFilterType = cdrBMP
Case JPG_FILE
GetFilterType = cdrJPEG
Case PPF_FILE
GetFilterType = cdrPPF
Case CPT_FILE
GetFilterType = cdrCPT10
Case TIF_FILE
GetFilterType = cdrTIFF
Case GIF_FILE
GetFilterType = cdrGIF
Case PNG_FILE
GetFilterType = cdrPNG
End Select
End Function
'given a filename, an extension and a destination folder, returns a unique filename by appending (n) to the basename, if necessary
Private Function GetNewFileName(FileName As String, NewFormat As String, Destination As String, Optional PageIndex As Long) As String
Dim NewFileName As String
Dim TempFileName As String
Dim Name As String
Dim Extension As String
Dim vFile As Variant
Dim n As Integer

n = 1
vFile = Split(FileName, ".")
If PageIndex <> 0 Then
TempFileName = vFile(0) & "-" & CStr(PageIndex)
Else
TempFileName = vFile(0)
End If
Extension = LCase(GetExtension(NewFormat))
Do
Name = TempFileName & "." & Extension
If Dir(Destination & Name) = "" Then
NewFileName = Name
Exit Do
Else
If PageIndex <> 0 Then
TempFileName = vFile(0) & "_" & n & "-" & CStr(PageIndex)
Else
TempFileName = vFile(0) & "_" & n
End If
End If
n = n + 1
Loop
GetNewFileName = Destination & NewFileName
End Function
'enables/disables the page size controls
Private Sub TogglePageSizeControls(Enable As Boolean)
ToggleCombo cboPageSize, Enable
optLandscape.Enabled = Enable
optPortrait.Enabled = Enable
lblWidth.Enabled = Enable
txtPageWidth.Enabled = Enable
lblHeight.Enabled = Enable
txtPageHeight.Enabled = Enable
lblUnits.Enabled = Enable
ToggleCombo cboUnits, Enable
spnHeight.Enabled = Enable
spnWidth.Enabled = Enable
If Enable = False Then
txtPageHeight.BackColor = vbButtonFace
txtPageWidth.BackColor = vbButtonFace
Else
txtPageHeight.BackColor = RGB(255, 255, 255)
txtPageWidth.BackColor = RGB(255, 255, 255)
End If
End Sub
'enables/disables the bitmap controls
Private Sub ToggleBitmapControls(Enable As Boolean)
chkImageHeight.Enabled = Enable
chkImageWidth.Enabled = Enable
ToggleSpinControl spnImageHeight, chkImageHeight.Value, chkImageHeight.Value
ToggleSpinControl spnImageWidth, chkImageWidth.Value, chkImageWidth.Value
chkAspectRatio.Enabled = (chkImageWidth.Value = True And chkImageHeight.Value = True And chkImageHeight.Enabled And chkImageWidth.Enabled)
chkAntiAliasing.Enabled = Enable
ToggleCombo cboColorModes, Enable
chkResolution.Enabled = Enable
ToggleSpinControl spnResolution, chkResolution.Value, chkResolution.Value
lblColorMode.Enabled = Enable
ToggleTextControl txtImageHeight, Enable, chkImageHeight.Value
ToggleTextControl txtImageWidth, Enable, chkImageWidth.Value
ToggleTextControl txtResolution, Enable, chkResolution.Value
cmdPalette.Enabled = Enable
End Sub

'if the filter class is initialized, it returns the filter settings from the class
Private Sub GetExportOptions(Format As String, ef As ExportFilter)
Select Case Format
Case EPS_FILE
If EPSOptions.Initialized Then
EPSOptions.SetProperties ef
End If
Case AI_FILE
If AIOptions.Initialized Then
AIOptions.SetProperties ef
End If
Case WPG_FILE
If WPGOptions.Initialized Then
WPGOptions.SetProperties ef
End If
Case WMF_FILE
If WMFOptions.Initialized Then
WMFOptions.SetProperties ef
End If
Case DXF_FILE
If DXFOptions.Initialized Then
DXFOptions.SetProperties ef
End If
Case JPG_FILE
If JPGOptions.Initialized Then
JPGOptions.SetProperties ef
End If
Case GIF_FILE
If GIFOptions.Initialized Then
GIFOptions.SetProperties ef
End If
Case PNG_FILE
If PNGOptions.Initialized Then
PNGOptions.SetProperties ef
End If
Case Else
End Select
End Sub

'returns a StructExportOptions with valid parameters
Private Function GetStructExport(Format As String) As StructExportOptions
Dim exp As StructExportOptions

Select Case Format
Case BMP_FILE
If BMPOptions.Initialized Then
Set exp = BMPOptions.SetProperties
Else
Set exp = CreateStructExportOptions
End If
Case TIF_FILE
If TIFOptions.Initialized Then
Set exp = TIFOptions.SetProperties
Else
Set exp = CreateStructExportOptions
End If
Case CPT_FILE, PPF_FILE, GIF_FILE, JPG_FILE, PNG_FILE
Set exp = CreateStructExportOptions
Case Else
End Select
GetStructExportParams exp
Set GetStructExport = exp
End Function

'Fills in StructExportOptions structure
Private Sub GetStructExportParams(exp As StructExportOptions)
Dim Width As Long
Dim Height As Long
Dim Resolution As Long

exp.AntiAliasingType = IIf(AntiAliasing, cdrNormalAntiAliasing, cdrNoAntiAliasing)
exp.ImageType = GetColorModeID(cboColorModes.Text)

Width = CDbl(txtImageWidth.Text)
Height = CDbl(txtImageHeight.Text)
If UseResolution Then
If txtResolution.Text <> "" Then
Resolution = CLng(txtResolution.Text)
Else
Resolution = DEFAULT_DPI
End If
Else
Resolution = DEFAULT_DPI
End If
exp.ResolutionX = Resolution
exp.ResolutionY = Resolution
If UseImageHeight And UseImageWidth Then exp.MaintainAspect = MaintainAspectRatio <> 0
If UseImageWidth Then exp.SizeX = Width Else exp.SizeX = 0
If UseImageHeight Then exp.SizeY = Height Else exp.SizeY = 0
End Sub

'given a color mode as a string, returns a cdrImageType on success or -1 on failure
Private Function GetColorModeID(ColorMode As String) As Long
Select Case ColorMode
Case COLOR_BW
GetColorModeID = cdrBlackAndWhiteImage
Case COLOR_16
GetColorModeID = cdr16ColorsImage
Case COLOR_GRAY
GetColorModeID = cdrGrayscaleImage
Case COLOR_PAL
GetColorModeID = cdrPalettedImage
Case COLOR_RGB
GetColorModeID = cdrRGBColorImage
Case COLOR_CMYK
GetColorModeID = cdrCMYKColorImage
Case Else
GetColorModeID = -1
End Select
End Function

Private Sub UnloadAllForms()
Unload frmSourceSelection
Unload frmBMPOptions
Unload frmTIFOptions
Unload frmPNGOptions
Unload frmPaletteOptions
End Sub

Private Sub CreateShape(d As Document)
Dim s As Shape
Set s = d.ActiveLayer.CreateEllipse2(d.ActivePage.CenterX, d.ActivePage.CenterY, 0.5, 0.25)
s.Fill.UniformColor.CMYKAssign 0, 0, 100, 0
End Sub

Private Sub UserForm_Terminate()
UnloadAllForms
End Sub
 
Upvote 0 Downvote
Is this the way to share the code information? I realize that I added a lot of code to this thread.

What is the best way to integrate the code you've created?

I think the ultimate solution is that this macro starts with a dialogue window where you can select the 'read' and the 'save' folder (with or without the possebility to batch convert a whole directorystructure).
This macro can do just one thing: CMX to CDR version10. Nothing more or less.
Then the batch can start.

Am I right?
I have no idea if that's possible or how much coding that takes.

If you don't like to do this it's OK. I look further.

Greetz,
Funky
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

gmoorthy
  • Locked
  • Question Question
Windows batch program - check for files
Replies
6
Views
328
gmoorthy
gmoorthy
knifey
  • Locked
  • Question Question
Formula help! &lt;&gt; SEARCH result within SUMPRODUCT
Replies
4
Views
223
SkipVought
S
Gavona
  • Locked
  • Question Question
Userform label not visible...sometimes=&gt; force it to be drawn?
Replies
4
Views
627
Gavona
Gavona
Alcedes
  • Locked
  • Question Question
NBTSTAT -a &lt;ip address&gt;
Replies
3
Views
265
Alcedes
Alcedes
Gavona
  • Locked
  • Question Question
Avoid looping =&gt;Speed code manipulating text
Replies
10
Views
307
SkipVought
S

Part and Inventory Search

Sponsor

Back
Top