I'm not hopeful, but is there by chance a way to export layers separately? i.e. if a PP project has say 10 layers am I able to export them as individual images? I know I can do it one at a time with the "export selected only" setting, but I'm looking for a way to do it all in one shot.
I hadn't tried this before, and make no claims that it's "good code", but this seemed to work OK for me in a couple of tests I tried in X7.
Sub save_layers_as_files()Dim index_counter As LongDim layer_name As StringDim orig_filenameDim saveas_filename As StringDim d As Documentorig_filename = ActiveDocument.FileNameFor index_counter = 1 To ActiveDocument.Layers.Count 'get layer name layer_name = ActiveDocument.Layers(index_counter).Name 'cook up new filename saveas_filename = "C:\Temp\" & orig_filename & "_" & layer_name & ".PNG" 'copy this layer ActiveDocument.Layers.Item(index_counter).Copy 'new document from clipboard Set d = Application.CreateDocumentFromClipboard 'saveas this document d.SaveAs(saveas_filename, cdrPNG).Finish 'close this document ActiveDocument.CloseNext index_counterEnd Sub
Note that, in the SaveAs, you get to select the export filter. In the code shown above, I made it PNG.
When doing the SaveAs, one can also use "StructSaveOptions" to set the details for how the export is carried out. I don't know the details of how to implement that, but I know that it exists.
pranderson said:Nice! I was trying something as well, but I didn't get as far as you did. Got hung up on how to use the layer name for the new filename. The macro "seems" to run fine, but where do the images save??? ...or where do I add the folder I want them in? I see it creates something in the Temp folder, but I'm clueless as to where the images went. Patti
It should be exporting the images right to that folder - C:\Temp. That's what it does on my system.
I tried to slick it up by using Application.CorelScriptTools.GetFolder to allow the user to browse to select the desired target folder. The GetFolder thing works for me in CorelDraw X7, but in Photo-Paint X7, it's throwing an error for me.
ETA: I found a post from Shelby Moore in the Developer Area confirming that it won't work, and offering some more sophisticated code as his suggested way to accomplish the folder browsing.
Eskimo said:It should be exporting the images right to that folder - C:\Temp. That's what it does on my system.
Found the images -- I was looking in the wrong temp folder (my User Temp).
Yes, a browse feature would be handy, but this macro will be very useful as it is. I appreciate you sharing it here, it helps me learn!
Patti
I'm glad you found it useful, Patti. My experience with this is limited enough that it was a learning exercise for me, too!
What really gripes me about that is that Corel shows the GetFolder stuff right on their own web site for Photo-Paint X7:
How on earth would I know that I'm not doing something wrong - because, at this point, I'm doing lots of thing wrong - but that it doesn't actually work?
Well, only by finding a post from the very knowledgeable Shelby Moore, that's how...
Save
OK, I used a sort of ugly way to select a folder using CorelScriptTools.GetFileBox, which appears to work for me in Photo-Paint X7.
The ugly part is that it's a "file open" dialog that returns the filename (including the full path) as a string. The filename is already filled in as "foo". So, if that's left alone, then the path to the directory can be had just by trimming the "foo" off of the end of the string.
The not-to-ugly part is that it seems to work. The whole macro, with that added:
Sub save_layers_as_files()Dim index_counter As LongDim layer_name As StringDim orig_filenameDim saveas_filename As StringDim d As Document'cheat here to use GetFileBox as a way to choose a folderDim filename_to_get_dir As StringDim pathname_of_dir As Stringfilename_to_get_dir = Application.CorelScriptTools.GetFileBox(, "Select Targer Folder", , "foo")If filename_to_get_dir = "" Then Exit SubEnd If'clip the "foo" off to leave just the path namepathname_of_dir = Replace(filename_to_get_dir, "foo", "")orig_filename = ActiveDocument.filenameFor index_counter = 1 To ActiveDocument.Layers.Count 'get layer name layer_name = ActiveDocument.Layers(index_counter).Name 'cook up new filename saveas_filename = pathname_of_dir & orig_filename & "_" & layer_name & ".PNG" 'copy this layer ActiveDocument.Layers.Item(index_counter).Copy 'new document from clipboard Set d = Application.CreateDocumentFromClipboard 'saveas this document d.SaveAs(saveas_filename, cdrPNG).Finish 'close this document ActiveDocument.CloseNext index_counterEnd Sub
After sleeping on it, I think that I would prefer to use more of a "KISS principle" approach to the location for the new files, and simply put them in the same place as the original.
Sub save_layers_as_files()Dim index_counter As LongDim layer_name As StringDim original_filepath_plus_filename As StringDim saveas_filepath_plus_filename As StringDim d As Documentoriginal_filepath_plus_filename = ActiveDocument.FilePath & ActiveDocument.FileNameFor index_counter = 1 To ActiveDocument.Layers.Count 'get layer name layer_name = ActiveDocument.Layers(index_counter).Name 'cook up new path + filename saveas_filepath_plus_filename = original_filepath_plus_filename & "_" & layer_name & ".PNG" 'copy this layer ActiveDocument.Layers.Item(index_counter).Copy 'new document from clipboard Set d = Application.CreateDocumentFromClipboard 'saveas this document d.SaveAs(saveas_filepath_plus_filename, cdrPNG).Finish 'close this document ActiveDocument.CloseNext index_counterEnd Sub