This is my code

Sub ClearShapeonPage()
    Dim shp As Visio.Shape
    Dim I As Long, N As Long
    N = ActivePage.Shapes.Count
    For I = N To 1 Step -1
    ActivePage.Shapes(I).Delete
    Next
End Sub
Sub FirstPage()
    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140
    'Application.ActiveWindow.ViewFit = visFitPage
    ClearShapeonPage
    Application.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation).FormulaForceU = "2"
    Application.EndUndoScope UndoScopeID1, True
    Application.Documents.OpenEx "server_u.vss", visOpenRO + visOpenDocked
    Application.Documents.OpenEx "netloc_u.vss", visOpenRO + visOpenDocked
    Application.Documents.OpenEx "comps_u.vss", visOpenRO + visOpenDocked
    'Connection
    Set stnObj = Application.Documents.OpenEx("SERVER_M.VSS", visOpenDocked)
    Set mstObjConnector = stnObj.Masters("Dynamic connector")
    
    'Active main page
    Application.Windows.ItemEx("test").Activate
    
    'KMS --> shpObjSever
    Dim shpObjSever As Visio.Shape
    Set shpObjSever = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 3.543307, 4.822835)
    'Add Color *** Read Status from DB
    shpObjSever.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(255,0,0))"
    For Each objShape In shpObjSever.Shapes
        objShape.CellsU("FillForegnd").FormulaForceU = "RGB(255,0,0)"
    Next
    
    'GDS --> shpObjGDS and Connect to KMS
    Dim shpObjGDS As Shape
    Set shpObjGDS = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 6.732283, 6.988189)
    Set shpObjConnector1 = ActivePage.Drop(mstObjConnector, 0, 0)
    shpObjConnector1.SendToBack
    shpObjConnector1.Cells("BeginX").GlueTo shpObjSever.Cells("Connections.X1")
    shpObjConnector1.Cells("EndX").GlueTo shpObjGDS.Cells("Connections.X1")
    'Add Color *** Read Status from DB
    shpObjGDS.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(0,255,0))"
    For Each objShape In shpObjGDS.Shapes
        objShape.CellsU("FillForegnd").FormulaForceU = "RGB(0,255,0)"
    Next
    'VKB --> shpObjGDS and Connect to KMS
    Dim shpObjVKB As Shape
    Set shpObjVKB = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 6.732283, 4.822835)
    Set shpObjConnector2 = ActivePage.Drop(mstObjConnector, 0, 0)
    shpObjConnector2.SendToBack
    shpObjConnector2.Cells("BeginX").GlueTo shpObjSever.Cells("Connections.X1")
    shpObjConnector2.Cells("EndX").GlueTo shpObjVKB.Cells("Connections.X1")
    'Add Color *** Read Status from DB
    shpObjVKB.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(0,255,0))"
    For Each objShape In shpObjVKB.Shapes
        objShape.CellsU("FillForegnd").FormulaForceU = "RGB(0,255,0)"
    Next
    
    
    'Bemis --> shpObjGDS and Connect to KMS
    Dim shpObjBemis As Shape
    Set shpObjBemis = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 6.732283, 2.46063)
    Set shpObjConnector3 = ActivePage.Drop(mstObjConnector, 0, 0)
    shpObjConnector3.SendToBack
    shpObjConnector3.Cells("BeginX").GlueTo shpObjSever.Cells("Connections.X1")
    shpObjConnector3.Cells("EndX").GlueTo shpObjBemis.Cells("Connections.X1")
    'Add Color *** Read Status from DB
    'shpObjBemis.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick).FormulaU = "RUNADDON(""NewMacros.BemisShow"")"
    shpObjBemis.Cells("EventDblClick").FormulaU = "RUNADDON(""NewMacros.BemisShow"")"
    'shpObjBemis.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(0,255,0))"
    For Each objShape In shpObjBemis.Shapes
        objShape.CellsU("FillForegnd").FormulaForceU = "RGB(0,255,0)"
        'objShape.CellsU("EventDblClick").FormulaForceU = "RUNADDON(""NewMacros.BemisShow"")"
    Next
    Application.EndUndoScope UndoScopeID1, True
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices
    
    Visio.Application.Addons("dbrs").Run "shpObjSever"
End Sub
Sub BemisShow()
MsgBox "Welcome!"
UserForm1.Show
End Sub