Code:
Option Explicit
Sub divideVertically()
cutInHalf 1
End Sub
Sub divideHorizontally()
cutInHalf 2
End Sub
Private Sub cutInHalf(Optional method As Integer)
Dim s As Shape, rect As Shape, rect2 As Shape
Dim trimmed1 As Shape, trimmed2 As Shape
Dim x As Double, y As Double, w As Double, h As Double
Dim vBool As Boolean
Dim leeway As Double
Dim sr As ShapeRange, sr2 As New ShapeRange
vBool = True
If method = 2 Then
vBool = False
End If
leeway = 0.1
Set sr = ActiveSelectionRange
ActiveDocument.BeginCommandGroup "Cut in half"
For Each s In sr
s.GetBoundingBox x, y, w, h
If (vBool) Then
'vertical slice
Set rect = ActiveLayer.CreateRectangle2(x - leeway, y - leeway, (w / 2) + leeway, h + (leeway * 2))
Set rect2 = ActiveLayer.CreateRectangle2(x + (w / 2), y - leeway, (w / 2) + leeway, h + (leeway * 2))
Else
Set rect = ActiveLayer.CreateRectangle2(x - leeway, y - leeway, w + (leeway * 2), (h / 2) + leeway)
Set rect2 = ActiveLayer.CreateRectangle2(x - leeway, y + (h / 2), w + (leeway * 2), (h / 2) + leeway)
End If
Set trimmed1 = rect.Intersect(s, True, True)
rect.Delete
Set trimmed2 = rect2.Intersect(s, True, True)
s.Delete
rect2.Delete
sr2.Add trimmed1
sr2.Add trimmed2
Next s
ActiveDocument.EndCommandGroup
sr2.CreateSelection
End Sub