Hi all,
I have created a macro to change the Country of Origin text in a cd label file and I also have created a macro to remove some guide rings in the same label file but I am unable to combine the 2 macros into one macro I can run on the cd label file. The code for each macro is as below.
Sub Rings() ' Recorded 27/04/2012 ActivePage.GuidesLayer.Visible = True ActivePage.GuidesLayer.Visible = False ActivePage.Layers("Guidelines_2").Visible = True ActivePage.Layers("Guidelines_2").Visible = False ActivePage.Layers("Guidelines").Visible = False ActivePage.Layers("Guidelines").Visible = True ActiveLayer.Visible = False ActiveLayer.Visible = True ActivePage.Layers("Graphic Elements").Visible = False ActivePage.Layers("Graphic Elements").Visible = True ActivePage.Layers("Guidelines").Visible = FalseEnd Sub
'TextReplacePublic Function FindReplace(ByVal str As String, ByVal toFind As String, ByVal toReplace As String) As String Dim i As Integer For i = 1 To Len(str) If Mid(str, i, Len(toFind)) = toFind Then ' does the string match? FindReplace = FindReplace & toReplace ' add the new replacement to the final result i = i + (Len(toFind) - 1) ' move to the character after the toFind Else FindReplace = FindReplace & Mid(str, i, 1) ' add a character End If Next iEnd Function
Public Sub TextTranslate() Dim s As Shape ActiveDocument.BeginCommandGroup "Text Translate" For Each s In ActiveDocument.ActivePage.Shapes If s.Type = cdrTextShape Then s.Text.Story = FindReplace(s.Text.Story, "Recorded in Ireland", "Recorded in China") s.Text.Story = FindReplace(s.Text.Story, "Printed in Ireland", "Printed in China") End If Next s ActiveDocument.EndCommandGroupEnd Sub
I would very much appreciate help from anybody on how I could (1) join the 2 macros above or (2) create a batch macro for each macro above I could run to update all coreldraw cd label files in a folder.
Thanks in advance to all !!!
I haven't tested it, but I think you need to add something like:
harryLondon: I haven't tested it, but I think you need to add something like: sub newsub() Rings() TextTranslate()End Sub
HI.
Right, this will run each. You don't need the brackets though. If you prefer to see the brackets you can use
Call Rings()
Else you just say
Rings
~John
"The best thing about learning is that it never stops, and the rabbit hole will go as deep as you let it."~Johnwww.gdgmacros.com
Hi guys thank you very much your solution is elegant and works perfect !
I know I am pushing my luck but could you advise me on how you could run such a macro on a number of cd label coreldraw files, without having to open each file and run the new macro?
Thanks
Hi.
Easiest way is to make a copy of the built in file converter macro.
Use to create a copy, ie new file, with your needed modifications. This way you have to old as a backup and can delete that when safe.
Use to convert cdr to cdr and paste code after last line here. Find this code in the code view of the frmFileConvertor: (I added some extra code for context to help you find it easier. Add you code after the last line)
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)
'ADD BELOW HERE..........................
Hi John - you help again is very much appreciated !!!
I do not seem to be able to get the ring removal macro to work when I paste the code into the frmFileConvertor code, even though it work fine with all cdr cd label files when run on each file separately, I get the error "Layer 'Guidelines_2' not found" and no new files are created in my destination folder.
The Text Replace macro does appear to work however I find that my new cdr files created are of size 210 x 297 mm whereas my original cdr files were of size 4.724 x 4.724 in.
Can you advise on where I am going wrong please ?
keithkeller:Can you advise on where I am going wrong please ?
No time to dig into it but here;s a good tip for ya. In code view place a break point right at the start of your inserted code. You do this with one single click next to the line of code on the right in the gray area until you get a red dot. Run the macro. Macro will pause there when you run. Press F8 to slowly run each line one by one until you see the error.
Also open your locals windows. Go to view > Locals Window and place a check mark next to it. This window shows you values for all variables when in debug mode
Hope it helps.
Hi John,
Thanks for your help again. I was able to resolve the page resizing by inputting some additional line of code to convert a cdr file to size 120 x 120 mm.