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, everybody
Let me share with you some practical ideas in the form of code.The code could certainly be better. The best thing is that this code can be made to suit practical needs as much as possible.
To achieve the result presented in the picture, we use a custom form /with a red button/.Pressing the red button places markers around the active shape.
In the form, only the red button and the controls attached to it are important. All other controls are operational and irrelevant to this task.
And here is the code for the red button:Dim Mtopy, Mleftx, Mrightx, Mbottomy As DoubleDim mshape As ShapeSet mshape = ActiveShapeMtopy = mshape.topyMbottomy = mshape.BottomYMleftx = mshape.LeftXMrightx = mshape.RightXSet MLINE8 = ActiveLayer.CreateLineSegment(Mleftx, Mtopy, Mleftx - tbLength.Text, Mtopy)MLINE8.Name = "BhBp8"Set MLINE1 = ActiveLayer.CreateLineSegment(Mleftx, Mtopy, Mleftx, Mtopy + tbLength.Text)MLINE1.Name = "BhBp1"Set MLINE2 = ActiveLayer.CreateLineSegment(Mrightx, Mtopy, Mrightx, Mtopy + tbLength.Text)MLINE2.Name = "BhBp2"Set MLINE3 = ActiveLayer.CreateLineSegment(Mrightx, Mtopy, Mrightx + tbLength.Text, Mtopy)MLINE3.Name = "BhBp3"Set MLINE4 = ActiveLayer.CreateLineSegment(Mrightx, Mbottomy, Mrightx + tbLength.Text, Mbottomy)MLINE4.Name = "BhBp4"Set MLINE5 = ActiveLayer.CreateLineSegment(Mrightx, Mbottomy, Mrightx, Mbottomy - tbLength.Text)MLINE5.Name = "BhBp5"Set MLINE6 = ActiveLayer.CreateLineSegment(Mleftx, Mbottomy, Mleftx, Mbottomy - tbLength.Text)MLINE6.Name = "BhBp6"Set MLINE7 = ActiveLayer.CreateLineSegment(Mleftx, Mbottomy, Mleftx - tbLength.Text, Mbottomy)MLINE7.Name = "BhBp7"ActiveShape.Selected = Falsemshape.Selected = TrueEnd Sub
The task of the above code is to make markers along the border of the active shape.
If any of the markers are found to be on a black background and not visible, the corresponding controls around the red button are clicked and the markers color changes from black to white.Each control around the red button has a code. Below is the code of the top left control.
The codes of the other controls are similar. The job of each of these controls is to alternately change the color of the markers from black to white and vice versa.Private Sub frTopLeft_Click()Dim MActiveControl As FrameSet MActiveControl = ActiveControlIf MActiveControl.BackColor = vbWhite ThenMActiveControl.BackColor = vbBlackActivePage.Shapes("BhBp1").Outline.Color.RGBAssign 0, 0, 0ElseMActiveControl.BackColor = vbWhiteIf MActiveControl.BackColor = vbWhite ThenActivePage.Shapes("BhBp1").Outline.Color.RGBAssign 255, 255, 255End IfEnd IfEnd sub
There are several interesting approaches in the code. I can't explain them in detail. The most interesting of these, I think, is the use of the Shape.Name
There are quite a few professionally made macros presented on the forum and on the Internet. Here is an attempt to peek into the kitchen and see how they work. This code has the advantage that, without having many functionalities, it can be adapted for the specific needs of each user. If the user has VBA knowledge, he can do the adaptation himself.
Any idea or question related to improving the above code and adding new functionalities,any comment will be gratefully received.
Greetings!
thanks bhbp.bg2 i will give this a go.
Please try additional buttons to change mark color too!
Code for buttons to change color of marksPrivate Sub CommandButton9_Click()'RED MARKSFor X = 1 To 8ActivePage.Shapes("BhBp" & X).Outline.Color.RGBAssign 255, 0, 0NextEnd SubPrivate Sub CommandButton10_Click()'WHITE MARKSFor X = 1 To 8ActivePage.Shapes("BhBp" & X).Outline.Color.RGBAssign 255, 255, 255NextEnd SubPrivate Sub CommandButton11_Click()'BLACK MARKSFor X = 1 To 8ActivePage.Shapes("BhBp" & X).Outline.Color.RGBAssign 0, 0, 0NextEnd SubPrivate Sub CommandButton12_Click()'GREEN MARKSFor X = 1 To 8ActivePage.Shapes("BhBp" & X).Outline.Color.RGBAssign 0, 255, 0NextEnd SubPrivate Sub CommandButton13_Click()'BLUE MARKSFor X = 1 To 8ActivePage.Shapes("BhBp" & X).Outline.Color.RGBAssign 0, 0, 255NextEnd SubGreetings!
i finally figured this out but need help with checking to see if the user picked a shape. when i post my code is says this is "spam or abuse" is there a way to post code without getting this message
Excuse, me, but I don't understand:1. if the user picked a shape2. when i post my codePlease clarify! More details will be helpful to understand problem and to solve problem.Greetings!