Introduction
In my previous post, I shared a script to quickly manage your macro shortcuts. In this one, I’ll share 3 different scripts to expand or collapse your Business Data Objects.
Macro shortcuts
If you don’t know how to use the scripts, at the end of this post, you can watch the video which explains the steps.
First script
This script provides a user interface to define the action and scope:
Business Data Objects – Expand | Collapse
'#Language "WWB-COM" ''MACRO TITLE: Business Data Objects - Expand|Collapse ' MACRO VERSION: 1.1 'This macro expands or collapses the selected Business Data Objects ' or all the Business Data Objects of the current submodel ' ' Release notes ' 1.0 Initial version ' 1.1 Selected objects issue fixed '--------------------------------------------------------------------------- Option Explicit Const TITLE$ = "Business Data Objects - Expand|Collapse" Dim MyModel As Model Dim MySubModel As SubModel Dim MyBDODisplay As BusinessDataObjectDisplay Dim MyBDO As BusinessDataObject Dim MySelectedObject As SelectedObject Sub Main On Error GoTo errHandler Dim MyDiagram As Diagram Debug.Clear 'Get the current diagram. Set MyDiagram = DiagramManager.ActiveDiagram If Not MyDiagram Is Nothing Then 'Get the current model. Set MyModel = MyDiagram.ActiveModel If Not MyModel Is Nothing Then 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel If Not MySubModel Is Nothing Then If MySubModel.BusinessDataObjectDisplays.Count > 0 Then Begin Dialog UserDialog 310,119, TITLE,.DlgFunction ' %GRID:10,7,1,1 GroupBox 10,7,290,77,"Scope",.gbScope OptionGroup .ogScope OptionButton 30,28,260,14,"Selected Business Data Objects",.obBDOSelected OptionButton 30,56,260,14,"All Business Data Objects",.obBDOAll CancelButton 210,91,90,21 PushButton 10,91,90,21,"Expand",.pbExpand PushButton 110,91,90,21,"Collapse",.pbCollapse End Dialog Dim dlg As UserDialog Dialog dlg Else MsgBox "The current submodel doesn't contain any Business Data Object.", vbExclamation, TITLE End If End If End If End If Exit Sub errHandler: If Err.Number = 10031 Then ' Form is closing Else MsgBox "Error:" & vbCrLf & vbCrLf & Err.Description, vbExclamation, TITLE End If DiagramManager.EnableScreenUpdateEx(True, True) End Sub Rem See DialogFunc help topic for more information. Private Function DlgFunction(DlgItem As String, Action As Integer, SuppValue As PortInt) As Boolean Select Case Action Case 1 ' Dialog box initialization DlgEnable("gbScope", MySubModel.BusinessDataObjectDisplays.Count > 0) DlgEnable("obBDOSelected", MySubModel.SelectedObjects.Count > 0) If Not DlgEnable("obBDOSelected") Then DlgValue("ogScope", 1) End If DlgEnable("pbExpand", DlgEnable("gbScope")) DlgEnable("pbCollapse", DlgEnable("gbScope")) Case 2 Select Case DlgItem Case "pbExpand", "pbCollapse" Select Case DlgValue "ogScope" Case 0 ' Loop Selected objects For Each MySelectedObject In MySubModel.SelectedObjects ' Only manage the BDOs If MySelectedObject.Type = 108 Then ' Get the BDO Set MyBDO = MyModel.BusinessDataObjects.Item(MySelectedObject.ID) If Not MyBDO Is Nothing Then ' Get the BDO Display object Set MyBDODisplay = MySubModel.BusinessDataObjectDisplays(IIf(MyModel.Logical, MyBDO.LogicalName, MyBDO.PhysicalName)) If Not MyBDODisplay Is Nothing Then If DlgItem = "pbExpand" Then MyBDODisplay.Expand Else MyBDODisplay.Collapse End If End If End If End If Next MySelectedObject Case 1 ' Loop all BDOs of the current submodel For Each MyBDODisplay In MySubModel.BusinessDataObjectDisplays If DlgItem = "pbExpand" Then MyBDODisplay.Expand Else MyBDODisplay.Collapse End If Next MyBDODisplay Case Else ' No option selected: it should not be possible Debug.Print "No option selected" DlgFunction = True Exit Function End Select Debug.Print CStr(Now) & Chr(9) & "Done" Beep End Select End Select End Function
Second script
This script expands all the Business Data Objects of the current Submodel or only the selected BDOs if there’s a selection. There’s a beep when the macro has successfully completed its job, no UI.
'#Language "WWB-COM" ''MACRO TITLE: Business Data Objects - Expand ' MACRO VERSION: 1.1 'This macro expands the selected Business Data Objects if there's a selection ' or all the Business Data Objects of the current submodel ' ' Release notes ' 1.0 Initial version ' 1.1 Selected objects issue fixed '--------------------------------------------------------------------------- Option Explicit Const TITLE$ = "Business Data Objects - Expand" Sub Main Dim MyDiagram As Diagram Dim MyModel As Model Dim MySubModel As SubModel Dim MyBDODisplay As BusinessDataObjectDisplay Dim MyBDO As BusinessDataObject Dim MySelectedObject As SelectedObject Debug.Clear 'Get the current diagram. Set MyDiagram = DiagramManager.ActiveDiagram If Not MyDiagram Is Nothing Then 'Get the current model. Set MyModel = MyDiagram.ActiveModel If Not MyModel Is Nothing Then 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel If Not MySubModel Is Nothing Then If MySubModel.BusinessDataObjectDisplays.Count > 0 Then ' Some objects are selected If MySubModel.SelectedObjects.Count > 0 Then ' Loop Selected objects For Each MySelectedObject In MySubModel.SelectedObjects ' Only manage the BDOs If MySelectedObject.Type = 108 Then ' Get the BDO Set MyBDO = MyModel.BusinessDataObjects.Item(MySelectedObject.ID) If Not MyBDO Is Nothing Then ' Get the BDO Display object Set MyBDODisplay = MySubModel.BusinessDataObjectDisplays(IIf(MyModel.Logical, MyBDO.LogicalName, MyBDO.PhysicalName)) If Not MyBDODisplay Is Nothing Then MyBDODisplay.Expand End If End If End If Next MySelectedObject Else ' Loop all BDOs of the current submodel For Each MyBDODisplay In MySubModel.BusinessDataObjectDisplays MyBDODisplay.Expand Next MyBDODisplay End If Debug.Print CStr(Now) & Chr(9) & "Done" Beep Else MsgBox "The current submodel doesn't contain any Business Data Object.", vbExclamation, TITLE End If End If End If End If End Sub
Third script
This script is almost the same as the second one. Instead of expanding the Business Data Objects, it’s collapsing them.
'#Language "WWB-COM" ''MACRO TITLE: Business Data Objects - Collapse ' MACRO VERSION: 1.1 'This macro collapses the selected Business Data Objects if there's a selection ' or all the Business Data Objects of the current submodel ' ' Release notes ' 1.0 Initial version ' 1.1 Selected objects issue fixed '--------------------------------------------------------------------------- Option Explicit Const TITLE$ = "Business Data Objects - Collapse" Sub Main Dim MyDiagram As Diagram Dim MyModel As Model Dim MySubModel As SubModel Dim MyBDODisplay As BusinessDataObjectDisplay Dim MyBDO As BusinessDataObject Dim MySelectedObject As SelectedObject Debug.Clear 'Get the current diagram. Set MyDiagram = DiagramManager.ActiveDiagram If Not MyDiagram Is Nothing Then 'Get the current model. Set MyModel = MyDiagram.ActiveModel If Not MyModel Is Nothing Then 'Get the current submodel. Set MySubModel = MyModel.ActiveSubModel If Not MySubModel Is Nothing Then If MySubModel.BusinessDataObjectDisplays.Count > 0 Then ' Some objects are selected If MySubModel.SelectedObjects.Count > 0 Then ' Loop Selected objects For Each MySelectedObject In MySubModel.SelectedObjects ' Only manage the BDOs If MySelectedObject.Type = 108 Then Set MyBDO = MyModel.BusinessDataObjects(MySelectedObject.ID) If Not MyBDO Is Nothing Then Set MyBDODisplay = MySubModel.BusinessDataObjectDisplays.Item(IIf(MyModel.Logical, MyBDO.LogicalName, MyBDO.PhysicalName)) If Not MyBDODisplay Is Nothing Then MyBDODisplay.Collapse End If End If End If Next MySelectedObject Else ' Loop all BDOs of the current submodel For Each MyBDODisplay In MySubModel.BusinessDataObjectDisplays MyBDODisplay.Collapse Next MyBDODisplay End If Debug.Print CStr(Now) & Chr(9) & "Done" Beep Else MsgBox "The current submodel doesn't contain any Business Data Object.", vbExclamation, TITLE End If End If End If End If End Sub
Summary
In this blog post, we have supplied:
- 1 macro with a User Interface to expand or collapse your Business Data Objects.
- 2 macros without User Interface.
I’d suggest to add these 2 macros in your macros shortcuts for the Business Data Objects using the macro shared in my previous post as you can see in the screenshot above.
Bonus
A short video which shows how to create a macro from a script in ER/Studio Data Architect:
A video which shows the 3 scripts above in action: