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 15-06-2009, 18:08
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default save all grouped objects as a cdr file

Hi to all.
I'm new here but has been with coreldraw since ver8.
I currently use 12 but also have 14.

Can anyone help me. I need a macro that takes all objects/grouped items on a page and saves each as a new cdr file.
I have around 500 graphics I've been working on, all on the same page and need to save each one.

Any help would be appreciated.

Thanks,
John
Reply With Quote
  #2  
Old 16-06-2009, 18:11
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

I'm racking my brain and this comes close but I need it to only save the selected object...any ideas? (cdr12)


Sub Macro1()

Dim s As Shape
Dim SaveOptions As StructSaveAsOptions

Set SaveOptions = New StructSaveAsOptions

With SaveOptions
.EmbedVBAProject = True
.Filter = cdrCDR
.IncludeCMXData = False
.Range = cdrSelection
.EmbedICCProfile = False
.ThumbnailSize = cdr10KColorThumbnail
.Version = cdrCurrentVersion

End With



Dim var1 As Integer

var1 = 1

For Each s In ActiveDocument.ActivePage.Shapes






ActiveDocument.SaveAs "D:\graphics\temp\" & var1 & ".cdr", SaveOptions

var1 = var1 + 1

Next s




End Sub

Last edited by runflacruiser; 16-06-2009 at 18:15. Reason: wrong peice of code
Reply With Quote
  #3  
Old 16-06-2009, 18:21
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default i think I got it....yea super newbie

how's this:

Sub Macro1()
Dim s As Shape
Dim SaveOptions As StructSaveAsOptions

Set SaveOptions = New StructSaveAsOptions
With SaveOptions
.EmbedVBAProject = False
.Filter = cdrCDR
.IncludeCMXData = False
.Range = cdrSelection
.EmbedICCProfile = False
.ThumbnailSize = cdr10KColorThumbnail
.Version = cdrCurrentVersion

End With

Dim var1 As Integer

var1 = 1

For Each s In ActiveDocument.ActivePage.Shapes

s.AddToSelection


ActiveDocument.SaveAs "D:\graphics\temp\" & var1 & ".cdr", SaveOptions
s.RemoveFromSelection
var1 = var1 + 1

Next s

I know, I know....super newb.
Reply With Quote
  #4  
Old 17-06-2009, 21:55
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 Great Start

You are off to a great start, here is another way to do it using your basic approach.
Code:
Sub SaveEachShape()
    Dim s As Shape, i As Integer
    Dim SaveOptions As New StructSaveAsOptions

    With SaveOptions
        .EmbedVBAProject = False
        .Filter = cdrCDR
        .IncludeCMXData = False
        .Range = cdrSelection
        .EmbedICCProfile = False
        .ThumbnailSize = cdr10KColorThumbnail
        .Version = cdrCurrentVersion
    End With

    For i = 1 To ActivePage.Shapes.Count
        ActivePage.Shapes(i).CreateSelection
        ActiveDocument.SaveAs "C:\Temp\" & i & ".cdr", SaveOptions
    Next i
End Sub
Keep coding and have fun,

-Shelby
Reply With Quote
  #5  
Old 26-06-2009, 22:55
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default thanks, I'll try that.

I accomplished it with this and it worked great. I will have to try your code variation to.
It's pretty frustrating because I can do anything to my hearts desire with PHP but this makes me desperate. I searched your forum for various chunks of code which helped me to learn quickly.

I made sure to move each item to center of page before saving so it would have a background color of choice if I used corel's macro to convert the file to jpeg thumbs.

Code:
Sub SaveAllAsFile()
  
    Dim s As Shape
    Dim SaveOptions As StructSaveAsOptions
        
    Set SaveOptions = New StructSaveAsOptions
    
        With SaveOptions
        .EmbedVBAProject = False
        .Filter = cdrCDR
        .IncludeCMXData = False
        .Range = cdrSelection
        .EmbedICCProfile = False
        .ThumbnailSize = cdr10KColorThumbnail
        .Version = cdrCurrentVersion
        
        End With
        
    ActiveDocument.Pages(0).Layers("Guides").Color.RGBAssign 0, 0, 100
    ActiveDocument.MasterPage.SetSize 8.5, 11#
    With ActiveDocument.MasterPage
        .Orientation = cdrPortrait
        .PrintExportBackground = True
        .Bleed = 0#
        .Background = cdrPageBackgroundSolid
        .Color.CMYKAssign 0, 0, 0, 100
    End With
        
   foldername = "test"
   
    
    filename_add = ""
    'filename_add = "_alt1"
    'filename_add = "_alt2"
   
    
    sNewDir = "D:\All Graphics\" & foldername & ""

On Error Resume Next
   ChDir sNewDir
   If Err Then MkDir sNewDir
On Error GoTo 0

        
     
     Dim var1 As Integer
     'Dim foldername As String    
     
     var1 = 1
     
    For Each s In ActiveDocument.ActivePage.Shapes
        
    s.AddToSelection
    
    s.AlignToPageCenter cdrAlignHCenter
    s.AlignToPageCenter cdrAlignVCenter
    
    If var1 < 10 Then
        var2 = 0
Else
var2 = ""
        End If
    
    ActiveDocument.SaveAs "D:\All Graphics\" & foldername & "\" & foldername & "_" & var2 & "" & var1 & "" & filename_add & ".cdr", SaveOptions
       
    'Dim OrigSelection As ShapeRange
    'Set OrigSelection = ActiveSelectionRange
    'Dim expflt As ExportFilter
    'Set expflt = ActiveDocument.ExportBitmap("D:\All Graphics\" & foldername & "\" & foldername & "_" & var1 & "" & filename_add & ".jpg", cdrJPEG, cdrSelection, cdrCMYKColorImage, , , 100, 100, cdrNormalAntiAliasing, False, False, False, False, cdrCompressionNone)
    'With expflt
    '    .Progressive = False
     '   .Optimized = False
     ''   .SubFormat = 0
     '   .Compression = 10
     '   .Smoothing = 10
     '   .Finish
    'End With
    
    s.Delete
    ' s.RemoveFromSelection
    var1 = var1 + 1
    
    Next s
  
    ActiveDocument.Pages(0).Layers("Guides").Color.RGBAssign 0, 0, 100
    ActiveDocument.MasterPage.SetSize 8.5, 11#
    With ActiveDocument.MasterPage
        .Orientation = cdrPortrait
        .PrintExportBackground = True
        .Bleed = 0#
        .Background = cdrPageBackgroundNone
        .Color.CMYKAssign 0, 0, 0, 0
    End With

End Sub

..i will.
thanks.
Joh
Reply With Quote
Reply

Tags
save files


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
Aligning Grouped Objects bprice CorelDRAW/Corel DESIGNER VBA 1 12-10-2008 02:07
Save pdf as CorelDraw File Name ProofingGuy CorelDRAW/Corel DESIGNER VBA 8 12-06-2008 10:15
How to import values from a file, replace text,save file for each value with new name amaart CorelDRAW/Corel DESIGNER VBA 1 28-09-2007 13:41
VBA & Photoshop. How Save File anover format? igor___ CorelDRAW/Corel DESIGNER VBA 5 30-11-2006 11:28
Exporting Grouped Objects ddonnahoe CorelDRAW/Corel DESIGNER VBA 4 15-05-2004 10:12


All times are GMT -5. The time now is 00:57.


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