I am looking for a macro that will make crop marks with a white outline. the reason being if my black crop mark are on a black color i can see them. does anybody have code for this or an existing macro?
thanx
Hello,Please try red arrow buttons to move marks in/out
Code to move markers IN/OUT hor or vert on distance STEP
Private Sub CommandButton15_Click()'HOR ARROWS INActivePage.Shapes("BhBp1").LeftX = ActivePage.Shapes("BhBp1").LeftX + tbStep.ValueActivePage.Shapes("BhBp8").LeftX = ActivePage.Shapes("BhBp8").LeftX + tbStep.ValueActivePage.Shapes("BhBp7").LeftX = ActivePage.Shapes("BhBp7").LeftX + tbStep.ValueActivePage.Shapes("BhBp6").LeftX = ActivePage.Shapes("BhBp6").LeftX + tbStep.Value
ActivePage.Shapes("BhBp2").LeftX = ActivePage.Shapes("BhBp2").LeftX - tbStep.ValueActivePage.Shapes("BhBp3").LeftX = ActivePage.Shapes("BhBp3").LeftX - tbStep.ValueActivePage.Shapes("BhBp5").LeftX = ActivePage.Shapes("BhBp5").LeftX - tbStep.ValueActivePage.Shapes("BhBp4").LeftX = ActivePage.Shapes("BhBp4").LeftX - tbStep.ValueEnd SubPrivate Sub CommandButton16_Click()'HOR ARROWS OUTActivePage.Shapes("BhBp1").LeftX = ActivePage.Shapes("BhBp1").LeftX - tbStep.ValueActivePage.Shapes("BhBp8").LeftX = ActivePage.Shapes("BhBp8").LeftX - tbStep.ValueActivePage.Shapes("BhBp7").LeftX = ActivePage.Shapes("BhBp7").LeftX - tbStep.ValueActivePage.Shapes("BhBp6").LeftX = ActivePage.Shapes("BhBp6").LeftX - tbStep.Value
ActivePage.Shapes("BhBp2").LeftX = ActivePage.Shapes("BhBp2").LeftX + tbStep.ValueActivePage.Shapes("BhBp3").LeftX = ActivePage.Shapes("BhBp3").LeftX + tbStep.ValueActivePage.Shapes("BhBp5").LeftX = ActivePage.Shapes("BhBp5").LeftX + tbStep.ValueActivePage.Shapes("BhBp4").LeftX = ActivePage.Shapes("BhBp4").LeftX + tbStep.ValueEnd SubPrivate Sub CommandButton17_Click()'VERT AROWS OUTActivePage.Shapes("BhBp1").topy = ActivePage.Shapes("BhBp1").topy + tbStep.ValueActivePage.Shapes("BhBp8").topy = ActivePage.Shapes("BhBp8").topy + tbStep.ValueActivePage.Shapes("BhBp2").topy = ActivePage.Shapes("BhBp2").topy + tbStep.ValueActivePage.Shapes("BhBp3").topy = ActivePage.Shapes("BhBp3").topy + tbStep.Value
ActivePage.Shapes("BhBp7").BottomY = ActivePage.Shapes("BhBp7").BottomY - tbStep.ValueActivePage.Shapes("BhBp6").BottomY = ActivePage.Shapes("BhBp6").BottomY - tbStep.ValueActivePage.Shapes("BhBp5").BottomY = ActivePage.Shapes("BhBp5").BottomY - tbStep.ValueActivePage.Shapes("BhBp4").BottomY = ActivePage.Shapes("BhBp4").BottomY - tbStep.ValueEnd Sub
Private Sub CommandButton18_Click()'VERT ARROWS INActivePage.Shapes("BhBp1").topy = ActivePage.Shapes("BhBp1").topy - tbStep.ValueActivePage.Shapes("BhBp8").topy = ActivePage.Shapes("BhBp8").topy - tbStep.ValueActivePage.Shapes("BhBp2").topy = ActivePage.Shapes("BhBp2").topy - tbStep.ValueActivePage.Shapes("BhBp3").topy = ActivePage.Shapes("BhBp3").topy - tbStep.Value
ActivePage.Shapes("BhBp7").BottomY = ActivePage.Shapes("BhBp7").BottomY + tbStep.ValueActivePage.Shapes("BhBp6").BottomY = ActivePage.Shapes("BhBp6").BottomY + tbStep.ValueActivePage.Shapes("BhBp5").BottomY = ActivePage.Shapes("BhBp5").BottomY + tbStep.ValueActivePage.Shapes("BhBp4").BottomY = ActivePage.Shapes("BhBp4").BottomY + tbStep.ValueEnd SubGreetings!
i was saying i figure this out with code of my own and i wanted to post my code here but when i do it rejects it and tells me its spam of abusive. i can copy and paste my code here. can someone tell me how to do this?
1. All code must be in 1 form. More then 1 open forms are difficult to drive. More then - calls from form to macros or calls from macros to forms are difficult to drive to. When all code is in 1 form export/copy/move the form with code is possible
2. Property modal of form set to false is important if You want to work and the form remains open. Heigh recomendet
Greetings!
Hi bhbp.bg2. i just sent you my code but i not sure if i got the email address right. thanx
Hello,I have tested Your code. I think You have to little change to share it. A easiest way to share, i think, is to put all code in form frmCrop. Then open VBEditor, Project View and drag/drop frmCtop module to new project. New project is new CorelDRAW file. This file must be open at first. So You may drag/drop frmCrop to it. When You dragging a plus sign appears near the mouse cursor.You form must have txtSize, txtOffset text boxes, command button RUN CROP MARKS.Code for command button is Your code, with very little changes:
Private Sub CommandButton1_Click()'Me.Hide'RECIVED FROM
''Sub CropMark()''frmCrop.Show vbModeless''End Sub'''''*****************************************************''''Sub MyCrops()
On Error GoTo ErrDim shr As New ShapeRangeDim sGroup As ShapeDim cms As DoubleDim cmo As DoubleDim x As Double, y As Double, w As Double, h As DoubleDim ss As Double, os As DoubleDim s1 As Shape, s2 As Shape, s3 As Shape, s4 As Shape, s5 As Shape, s6 As Shape, s7 As Shape, s8 As ShapeDim s9 As Shape, s10 As Shape, s11 As Shape, s12 As Shape, s13 As Shape, s14 As Shape, s15 As Shape, s16 As Shape
'ss = InputBox("Enter reg mark radius size")ss = 0.25 ' reg mark sizeos = ss * 2 ' reg mark offset from bounding box'cms = 0.3125 ' crop mark size'cms = tbCms.Textcms = txtSize.Value'cmo = 0.0625 ' crop mark offsetcmo = txtOffset.Value
'cms = frmCrop.txtSize'cmo = frmCrop.txtOffset
Set sr = ActiveSelectionRangesr.GetBoundingBox x, y, w, h
If sr.Count = 0 Then GoTo Err
Set s1 = ActiveLayer.CreateLineSegment(x + w, y - cmo, x + w, y - cms - cmo)s1.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s1
Set s2 = ActiveLayer.CreateLineSegment(x + w, y - cmo, x + w, y - cms - cmo)s2.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s2
Set s3 = ActiveLayer.CreateLineSegment(x + w + cmo, y, x + w + cms + cmo, y)s3.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s3
Set s4 = ActiveLayer.CreateLineSegment(x + w + cmo, y, x + w + cms + cmo, y)s4.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s4
Set s5 = ActiveLayer.CreateLineSegment(x - cmo, y, x - cms - cmo, y)s5.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s5
Set s6 = ActiveLayer.CreateLineSegment(x - cmo, y, x - cms - cmo, y)s6.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s6
Set s7 = ActiveLayer.CreateLineSegment(x, y - cmo, x, y - cms - cmo)s7.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s7
Set s8 = ActiveLayer.CreateLineSegment(x, y - cmo, x, y - cms - cmo)s8.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s8
Set s9 = ActiveLayer.CreateLineSegment(x, y + h + cmo, x, y + h + cms + cmo)s9.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s9
Set s10 = ActiveLayer.CreateLineSegment(x, y + h + cmo, x, y + h + cms + cmo)s10.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s10
Set s11 = ActiveLayer.CreateLineSegment(x - cmo, y + h, x - cms - cmo, y + h)s11.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s11
Set s12 = ActiveLayer.CreateLineSegment(x - cmo, y + h, x - cms - cmo, y + h)s12.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s12
Set s13 = ActiveLayer.CreateLineSegment(x + w, y + h + cmo, x + w, y + h + cms + cmo)s13.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s13
Set s14 = ActiveLayer.CreateLineSegment(x + w, y + h + cmo, x + w, y + h + cms + cmo)s14.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s14
Set s15 = ActiveLayer.CreateLineSegment(x + w + cmo, y + h, x + w + cms + cmo, y + h)s15.Outline.SetProperties 0.021, , CreateRGBColor(255, 255, 255)shr.Add s15
Set s16 = ActiveLayer.CreateLineSegment(x + w + cmo, y + h, x + w + cms + cmo, y + h)s16.Outline.SetProperties 0.007, , CreateRGBColor(0, 0, 0)shr.Add s16
Set sGroup = shr.Group
ActiveDocument.ClearSelection
Exit SubErr:MsgBox "No shapes were slected. Please select shape/s and try again.", , "Crop Mark Maker"
End SubGreetings!
that all worked great. The only thing i have left to do is set Property modal of form set to false. can you tell me where to do this.
Hello, Boy,I'm happy to help You.At top of Your code are those 3 rows /now disabled, see at code above/''Sub CropMark()''frmCrop.Show vbModeless''End Sub
You have userform frmCrop. Is better to set modal=false in edit mode. Edit mode is when Visual Basic Editor is open. Then You must select from View/Project Explorer /if not opened by default/. Click on frmCrop in Project Explorer and see Properties of frmCrop. Find at bottom of Properties Window ShowModal property, click on ShowModal property, then down arrow and select False. So You change Modal property of frmCrop to false. So You may work without closing frmCrop. More then - code will work after calling frmCrop code. I'm not Shure You understand property Modal? If not - I can give You example.Greetings!