BhBp duplicate user form

Hello, people!
This VBA form is my Christmas present from me to You. It can be used to duplicate selected shape/shapes in direction-Top, Right, Down, Left. You can set up quantity, direction of the duplicated shapes and distance between them. If no dirrection selected, the duplicated shapes are stacked on top of the originally selected one. I wish You a peaceful and happy New 2024 Year! Let all wars in the world stop now! VBE This Form Show is additive bonus to You!
Greetings!

'Private buttonhandlers As Collection 'must be at top of ufCommands code
Private Sub cb_Bottom_Click()
Dim S1 As ShapeRange
Set S1 = ActiveSelectionRange
Dim S2 As ShapeRange
Set S2 = S1.Duplicate(0, -S1.SizeHeight - tbDistance / 25.4)
S1.RemoveFromSelection
S2.Shapes.All.AddToSelection
End Sub

Private Sub cb_Left_Click()
Dim S1 As ShapeRange
Set S1 = ActiveSelectionRange
Dim S2 As ShapeRange
Set S2 = S1.Duplicate(-S1.SizeWidth - tbDistance / 25.4, 0)
S1.RemoveFromSelection
S2.Shapes.All.AddToSelection
End Sub

Private Sub cb_Right_Click()

Dim S1 As ShapeRange
Set S1 = ActiveSelectionRange
Dim S2 As ShapeRange
Set S2 = S1.Duplicate(S1.SizeWidth + tbDistance / 25.4, 0)
S1.RemoveFromSelection
S2.Shapes.All.AddToSelection
End Sub

Private Sub cb_Top_Click()
Dim S1 As ShapeRange
Set S1 = ActiveSelectionRange
Dim S2 As ShapeRange
Set S2 = S1.Duplicate(0, S1.SizeHeight + tbDistance / 25.4)
S1.RemoveFromSelection
S2.Shapes.All.AddToSelection
End Sub

Private Sub cbDuplicateBottom_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
cbDuplicateRight = False
cbDuplicateTop = False
cbDuplicateLeft = False
End Sub

Private Sub cbDuplicateLeft_Click()
End Sub

Private Sub cbDuplicateLeft_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
cbDuplicateBottom = False
cbDuplicateRight = False
cbDuplicateTop = False
End Sub

Private Sub cbDuplicateRight_Click()

End Sub

Private Sub cbDuplicateRight_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
cbDuplicateBottom = False
cbDuplicateTop = False
cbDuplicateLeft = False
End Sub

Private Sub cbDuplicateTop_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
cbDuplicateBottom = False
cbDuplicateRight = False
cbDuplicateLeft = False
End Sub

Private Sub CommandButton1_Click()
Application.GlobalUserData("meTopLeft", 1) = Me.Top
Application.GlobalUserData("meTopLeft", 2) = Me.Left

Me.Hide
End Sub

Private Sub CommandButton6_Click()
On Error GoTo errorhandler

Dim S1 As ShapeRange, S2 As ShapeRange
'DUPLICATE RIGHT
If Me.cbDuplicateRight Then
For X = 1 To Me.tbDuplicate.Value
cb_Right_Click
Next
End If

'DUPLICATE LEFT
If Me.cbDuplicateLeft Then
For X = 1 To Me.tbDuplicate.Value
cb_Left_Click
Next
End If

'DUPLICATE TOP
If Me.cbDuplicateTop Then
For X = 1 To Me.tbDuplicate.Value
cb_Top_Click
Next
End If

'DUPLICATE BOTTOM
If Me.cbDuplicateBottom Then
For X = 1 To Me.tbDuplicate.Value
cb_Bottom_Click
Next
End If

If Me.cbDuplicateRight = False And Me.cbDuplicateLeft = False And Me.cbDuplicateTop = False And Me.cbDuplicateBottom = False Then
For X = 1 To Me.tbDuplicate.Value
'Dim S1 As ShapeRange
Set S1 = ActiveSelectionRange
' Dim S2 As ShapeRange
Set S2 = S1.Duplicate(0, 0)
S1.RemoveFromSelection


S2.Shapes.All.AddToSelection

Next
End If
Exit Sub
errorhandler:
MsgBox "PERHAPS NO SHAPE SELECTED. PLEASE SELECT ONE AND TRY AGAIN"
End Sub

Private Sub CommandButton7_Click()
Dim mwind As VBIDE.Window
'from excel
'Application.VBE.VBProjects(Application.VBE.SelectedVBComponent.VBE.ActiveVBProject.Name).VBComponents(mycontrol.Parent.Name).Activate
'UNSELECT ALL
Dim BHBP_shape_range As ShapeRange
Set BHBP_shape_range = ActiveSelectionRange
Dim s As Shape
For Each s In ActiveSelection.Shapes
'If s.Type = cdrRectangleShape Then s.Selected = False
s.Selected = False
Next s
'UNSELECT ALL
'Application.GlobalUserData("meTopLeft", 1) = Me.Top
'Application.GlobalUserData("meTopLeft", 2) = Me.Left

Dim vbeditor As VBIDE.VBE
Application.VBE.MainWindow.Visible = True
'Set WshShell = CreateObject("WScript.Shell")
'WshShell.SendKeys "^g"
'Debug.Print "immediate_window_BhBp_clear"

Set vbeditor = Application.VBE
''''''''''''''''MsgBox vbeditor.VBProjects("GlobalMacros").VBComponents.Count
'''''''''''''''
''''''''''''''''vbeditor.VBProjects("GlobalMacros").VBComponents("ufCommands").Activate
'''''''''''''''
''''''''''''''''vbeditor.VBProjects("GlobalMacros").VBComponents(Me.Name).Activate

vbeditor.ActiveVBProject.VBComponents(Me.Name).Activate

BHBP_shape_range.CreateSelection

'vbeditor.ActiveVBProject.VBComponents("ufCommands").Activate

End Sub

Private Sub CommandButton8_Click()
MsgBox Application.Name & " " & Application.VersionMajor

End Sub
Private Sub CommandButton9_Click()
End Sub

Private Sub Image1_Click()
Shell ("Explorer ">https://www.bhbp.bg")
End Sub

Private Sub Label6_Click()

End Sub

Private Sub UserForm_Activate()
'uf_BhBp_Duplicate_X3.Left = 50
FLAG = 0
On Error Resume Next 'if data field exist
ActiveDocument.DataFields.AddEx2 "", "webcgm", "DleftX", cdrDataTypeNumber, "", "", "", "", True, True, False
On Error Resume Next 'if data field exist
ActiveDocument.DataFields.AddEx2 "", "webcgm", "DrightX", cdrDataTypeNumber, "", "", "", "", True, True, False
On Error Resume Next 'if data field exist
ActiveDocument.DataFields.AddEx2 "", "webcgm", "DsizeWidth", cdrDataTypeNumber, "", "", "", "", True, True, False
On Error Resume Next 'if data field exist
ActiveDocument.DataFields.AddEx2 "", "webcgm", "DsizeHeight", cdrDataTypeNumber, "", "", "", "", True, True, False
On Error Resume Next 'if data field exist
ActiveDocument.DataFields.AddEx2 "", "webcgm", "DtopY", cdrDataTypeNumber, "", "", "", "", True, True, False
On Error Resume Next 'if data field exist
ActiveDocument.DataFields.AddEx2 "", "webcgm", "DbottomY", cdrDataTypeNumber, "", "", "", "", True, True, False
Me.Top = Application.GlobalUserData("meTopLeft", 1)
Me.Left = Application.GlobalUserData("meTopLeft", 2)
End Sub
Private Sub UserForm_Click()

End Sub
Private Sub UserForm_Initialize()
uf_BhBp_Duplicate_X5.Left = 50
'Dim Ctrl As Control
'Dim Ctrl1 As Control
'Dim ButtonHandler As ButtonEventHandler
'Set buttonhandlers = New Collection
'For Each Ctrl In Me.Controls
' If TypeName(Ctrl) = "CommandButton" Then
' Set ButtonHandler = New ButtonEventHandler
' Set ButtonHandler.CommandButton = Ctrl
' buttonhandlers.Add ButtonHandler
' End If
'Next Ctrl
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.GlobalUserData("meTopLeft", 1) = Me.Top
Application.GlobalUserData("meTopLeft", 2) = Me.Left
End Sub