I have a macro to add registration marks and a number to artwork prior to printing. It has always worked fine for me but as i have added on to it to further automate my workflow, It seems to corrupt any document i am working in. I cannot switch pages, the tool bars do not change. I have to restart Corel to fix the problem. Any reason this would be happening? Any help is appreciated. Thanks
Sub cropMarks_Vertical()
Dim sr As ShapeRange, sCirc As Shape, sline1 As Shape, sLine2 As Shape, sr2 As New ShapeRange, s As Shape, s3 As ShapeRange Dim x#, y#, w#, h# Dim dCropRadius# dCropRadius = 0.15 Set sr = ActiveSelectionRange If sr.Count = 0 Then Exit Sub sr.Group ActiveDocument.BeginCommandGroup "CropMarkCustom" sr.Group sr.GetBoundingBox x, y, w, h Set sCirc = ActiveLayer.CreateEllipse2(0, 0, dCropRadius, 0, 90, 180, True) sCirc.Fill.UniformColor.RegistrationAssign sCirc.Outline.Type = cdrNoOutline sr2.Add sCirc Set sCirc = ActiveLayer.CreateEllipse2(0, 0, dCropRadius, 0, 270, 0, True) sCirc.Fill.UniformColor.RegistrationAssign sCirc.Outline.Type = cdrNoOutline sr2.Add sCirc Set sCirc = ActiveLayer.CreateEllipse2(0, 0, dCropRadius) sCirc.Fill.ApplyNoFill sCirc.Outline.Color.RegistrationAssign sr2.Add sCirc Set sline1 = ActiveLayer.CreateLineSegment(0, 0, dCropRadius * 3.33, 0) Set sLine2 = ActiveLayer.CreateLineSegment(0, 0, 0, dCropRadius * 3.33) sline1.AlignToShape cdrAlignHCenter, sCirc: sline1.AlignToShape cdrAlignVCenter, sCirc: sr2.Add sline1 sLine2.AlignToShape cdrAlignHCenter, sCirc: sLine2.AlignToShape cdrAlignVCenter, sCirc: sr2.Add sLine2 Set s = sr2.Group Set sr2 = New ShapeRange: sr2.Add s s.AlignToShapeRange cdrAlignHCenter, sr ActiveDocument.ReferencePoint = cdrCenter s.Outline.Color.RegistrationAssign s.SetPositionEx cdrCenter, s.PositionX, y - 0.625 '(.5 + .125 ) Set s = s.Duplicate(0, h + 1.25) With s .Outline.Width = 0.01 'set width here in inches .Outline.Color.RegistrationAssign .Name = "VERTICAL Crop Marks" Dim Intext As String
Intext = InputBox("Enter Film Number:", "Film Number") If Intext = "" Then MsgBox "Film Number Must Be Entered Before File Is Printed" & vbCr & " Please Try Agin Or Enter Number Manually" sr2.Delete s.Delete Exit Sub Else Do Until Len(Intext) > 3 And Len(Intext) < 7 Intext = InputBox("Please Enter Film Number:", "Incorrect Film Number") If Ret = "" Then MsgBox "Film Number Must Be Entered Before File Is Printed" & vbCr & " Please Try Agin Or Enter Number Manually" sr2.Delete s.Delete Exit Sub Loop End If
ActiveLayer.CreateArtisticText 0, 0, Intext, , , , 12 Set s3 = ActiveSelectionRange s3(1).AlignToShape cdrAlignVCenter, s s3(1).AlignToShape cdrAlignHCenter, s s3(1).Fill.UniformColor.RegistrationAssign s3(1).Move 0.625, 0 sr2.Add s sr2.Add s3(1) sr2.Add sr(1)
Set s = sr2.Group s.CreateSelection Set s = ActiveSelection If s.Shapes.Count = 0 Then MsgBox "Please make a selection" Exit Sub End If retval = MsgBox("Would You Like To Center To Current Page?", _ vbYesNo, "Page Center") If retval = vbYes Then Else: Exit Sub End If s.GetSize w, h ActivePage.SizeHeight = Round(h + 1, Precision) ActivePage.SizeWidth = Round(w + 1, Precision) ActiveDocument.ReferencePoint = sCenter s.AlignAndDistribute VGCore.cdrAlignDistributeH.cdrAlignDistributeHAlignCenter, VGCore.cdrAlignDistributeV.cdrAlignDistributeVAlignCenter, VGCore.cdrAlignShapesTo.cdrAlignShapesToCenterOfPage End With End Sub
Hello cmbbowen; I don't know who wrote the macro, Bu if you emailed them and tell them what you want to do, You would be better off. It may cost you a little more but at least you would have something working for you.
George
I would try to change line
s.AlignAndDistribute VGCore.cdrAlignDistributeH.cdrAlignDistributeHAlignCenter, VGCore.cdrAlignDistributeV.cdrAlignDistributeVAlignCenter, VGCore.cdrAlignShapesTo.cdrAlignShapesToCenterOfPage
to
SendKeys ("p")
It' s shortcut for Arrange-Aling and Distribute-Center To Page
Best regards
Mek