Bugs after using macro

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

    • for add cropmarks, I always use this macro: http://oberonplace.com/vba/drawmacros/cropmarksh.htm
      The Macromonster's macro woks fine too http://macromonster.com/index.php?mod=descr&id_desc=15
    • 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