i am trying to create guideline with below mentioned code on outside of the page on all 4 side of 0.5mm exactly but unable to make it complete please help me
Sub label()
Dim D As Document
Dim p As PageSize
Dim x As Long, y As Long
Dim l As String
Dim n As Double
ActiveDocument.Unit = cdrMillimeter 'change to units desired
n = -0.5 'equals 1/2"
'------------------------ Undo Group Start ------------------------
ActiveDocument.BeginCommandGroup "Undo action description"
Optimization = True
EventsEnabled = False
ActiveDocument.SaveSettings
ActiveDocument.PreserveSelection = False
l = ActiveLayer.Name
x = ActivePage.SizeWidth - n
y = ActivePage.SizeHeight - n
ActivePage.Layers("Guides").CreateGuideAngle x, y, 0 ' Horizontal
ActivePage.Layers("Guides").CreateGuideAngle x, y, 90 ' Vertical
x = ActivePage.SizeWidth - ActivePage.SizeWidth + n
y = ActivePage.SizeHeight - ActivePage.SizeHeight + n
ActiveDocument.RestoreSettings
EventsEnabled = True
Optimization = False
Application.Refresh
ActiveWindow.Refresh
ActiveDocument.EndCommandGroup
'------------------------ Undo Group End ------------------------
ActiveDocument.ClearSelection
ActivePage.Layers(l).Activate
End Sub
One way to do this would be to write a function for creating four guidelines offset from the edges of the page:
Function create_guidelines_offset_from_page(ByVal Offset_Dist As Double, ByVal Offset_Units As cdrUnit) As ShapeRange Dim dblOffsetDocUnits As Double Dim srGuidesCreated As New ShapeRange 'get offset in document units dblOffsetDocUnits = ActiveDocument.ToUnits(Offset_Dist, Offset_Units) 'horizontal, top srGuidesCreated.Add ActiveLayer.CreateGuide(ActivePage.LeftX, ActivePage.TopY + dblOffsetDocUnits, ActivePage.RightX, ActivePage.TopY + dblOffsetDocUnits) 'horizontal, bottom srGuidesCreated.Add ActiveLayer.CreateGuide(ActivePage.LeftX, ActivePage.BottomY - dblOffsetDocUnits, ActivePage.RightX, ActivePage.BottomY - dblOffsetDocUnits) 'vertical, left srGuidesCreated.Add ActiveLayer.CreateGuide(ActivePage.LeftX - dblOffsetDocUnits, ActivePage.TopY, ActivePage.LeftX - dblOffsetDocUnits, ActivePage.BottomY) 'vertical, right srGuidesCreated.Add ActiveLayer.CreateGuide(ActivePage.RightX + dblOffsetDocUnits, ActivePage.TopY, ActivePage.RightX + dblOffsetDocUnits, ActivePage.BottomY) If srGuidesCreated.Count > 0 Then Set create_guidelines_offset_from_page = srGuidesCreated End If End Function
You could then write much smaller subs to use that function, where you could specify the size of the offset (which would be a negative number if you want the guidelines inside the page) and the units for the offset. Because the function returns a shaperange, you can also do other things with the shapes, such as moving them to a specific layer, selecting them, etc.:
Sub test_guides_offset_from_page_Alfa() Dim sr As ShapeRange Set sr = create_guidelines_offset_from_page(5, cdrMillimeter) sr.MoveToLayer ActivePage.GuidesLayer sr.CreateSelection Refresh End Sub
Sub test_guides_offset_from_page_Bravo() Dim sr As ShapeRange Set sr = create_guidelines_offset_from_page(1, cdrInch) sr.MoveToLayer ActivePage.GuidesLayer sr.CreateSelection Refresh End Sub
Sub test_guides_offset_from_page_Charlie() Dim sr As ShapeRange Set sr = create_guidelines_offset_from_page(-0.75, cdrCentimeter) sr.MoveToLayer ActivePage.GuidesLayer sr.CreateSelection Refresh End Sub
This post is really just about creating the guidelines. If I were going to give this to my users, then I would add additional code to make it safer, nicer, and more convenient (e.g., error handling, a command group for a single Undo, optimization).
thanks alot eskimo.