Please revise my code

Is it to messy?

Global box_x As Double
Global box_y As Double
Global Shape_rx As Double
Global x As Double
Global y As Double
Global x1 As Double
Global in_x As Double

Sub Bound_box()
Dim i
Dim Layer_PB As Boolean

ActivePage.Shapes().All.CreateSelection

i = 0

Do While i < ActivePage.Layers.Count
       i = i + 1
       ActivePage.Layers(i).Activate
       If ActiveLayer.Name = "PB" Then
       Layer_PB = True
       End If
Loop

If Layer_PB = True Then
    Create_bx2              ' if active layer name is "PB" then we create only boxes
    Else
    Create_bx               ' if active layer name is not "PB" then we create layer
    End If

End Sub

' Create Layer PB

Function Create_bx()
    ActivePage.CreateLayer "PB"
    Create_bx2
End Function

' Activate Layer and make boxes

Function Create_bx2()
            
    in_x = 10
          
    Shape_rx = ActiveSelection.RightX
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ActivePage.GetSize box_x, box_y
    ActivePage.Layers("PB").Activate
    RL = Shape_rx
    x = Shape_rx + in_x
    y = box_y - in_x
    x1 = box_y
    
    ActiveLayer.CreateRectangle RL, x1, x, y, 0, 0, 0, 0
    ActiveLayer.CreateRectangle 0, 0, in_x, in_x, 0, 0, 0, 0
    ActiveLayer.Shapes.All.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
    ActiveLayer.Shapes.All.SetOutlineProperties (0)
    ActiveLayer.Shapes.All.Group
End Function

I have a problem with Shape_rx variable

Why dose it keep the same value even if i don't have any objects on the page?

[shelbym]

Here is my slightly different version. As you will see I use a Function to look for the layer and if it can't find it creates it.

Sub Bound_box()
    Const in_x As Double = 10
    Dim srAll As ShapeRange, srBoxes As New ShapeRange
    Dim lr As Layer, doc As Document
    Dim box_x As Double, box_y As Double, Shape_rx As Double
    Dim x As Double, x1 As Double, y As Double
        
    Set doc = ActiveDocument
    Set srAll = doc.ActivePage.Shapes.All
    doc.Unit = cdrMillimeter
    doc.ActivePage.GetSize box_x, box_y
    Shape_rx = srAll.RightX
    
    x = Shape_rx + in_x
    y = box_y - in_x
    x1 = box_y
 
    Set lr = FindLayer(ActivePage, "PB")
    lr.Activate
    
    srBoxes.Add lr.CreateRectangle(Shape_rx, x1, x, y)
    srBoxes.Add lr.CreateRectangle(0, 0, in_x, in_x)
    
    srBoxes.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
    srBoxes.SetOutlineProperties 0
    srBoxes.Group
End Sub

Function FindLayer(ByVal pg As Page, ByVal Name As String) As Layer
    Dim LayerFound As Layer
    Dim lr As Layer
    
    Set LayerFound = Nothing
    
    For Each lr In pg.Layers
        If lr.Name = Name Then
            Set LayerFound = lr
            Exit For
        End If
    Next lr
    
    If LayerFound Is Nothing Then
        Set LayerFound = ActivePage.CreateLayer(Name)
    End If
    
    Set FindLayer = LayerFound
End Function

Best of luck,

-Shelby

Thank you for your time

Yours its much more cleaner