I added Predefined Conditions to the mass update utility of Dwayne Hoffpauir.
https://bobj-board.org/t/21029
So this utility can update Objects, Classes and Predefined Conditions
This version is for Designer XI (tested on XI 3.1 sp2).
Option Explicit 'require variables to be declared before being used
Dim DesignerApp As Designer.Application
Dim Univ As Designer.Universe
Dim Wksht As Excel.Worksheet
Sub GetInfo()
Set DesignerApp = New Designer.Application
DesignerApp.Visible = True
Call DesignerApp.LogonDialog
Set Univ = DesignerApp.Universes.Open
DesignerApp.Visible = False
Set Wksht = ThisWorkbook.Worksheets("Objects")
Wksht.Unprotect
Range("Objects").ClearContents
Call GetObjectInfo(Univ.Classes, 1)
' Range("Objects").Resize(Wksht.UsedRange.Rows.Count - 1, 5).Name = "Objects" - setting the size of the Objects range was moved to the GetObjectInfo() sub (Marek Chladny)
Range("Objects").Columns("D:E").Value = Range("Objects").Columns("B:C").Value
Range("Objects").Columns("A:C").Locked = True
Range("Objects").Columns("D:E").Locked = False
Wksht.Protect
' -------- added by Marek Chladny ------
Set Wksht = ThisWorkbook.Worksheets("Classes")
Wksht.Unprotect
Range("Classes").ClearContents
Call GetClassInfo(Univ.Classes, 1)
' Range("Classes").Resize(Wksht.UsedRange.Rows.Count - 1, 4).Name = "Classes" - setting the size of the Classes range was moved to the GetClassInfo() sub (Marek Chladny)
Range("Classes").Columns("C:D").Value = Range("Classes").Columns("A:B").Value
Range("Classes").Columns("A:B").Locked = True
Range("Classes").Columns("C:D").Locked = False
Wksht.Protect
' --------------------------------------
' -------- added by Romain Jubert ------
Set Wksht = ThisWorkbook.Worksheets("Conditions")
Wksht.Unprotect
Range("Conditions").ClearContents
Call GetPredefinedConditionInfo(Univ.Classes, 1)
' Range("Objects").Resize(Wksht.UsedRange.Rows.Count - 1, 5).Name = "Conditions" - setting the size of the Objects range was moved to the GetObjectInfo() sub (Marek Chladny)
Range("Conditions").Columns("D:E").Value = Range("Conditions").Columns("B:C").Value
Range("Conditions").Columns("A:C").Locked = True
Range("Conditions").Columns("D:E").Locked = False
Wksht.Protect
' --------------------------------------
Set Wksht = Nothing
DesignerApp.Quit
Set Univ = Nothing
Set DesignerApp = Nothing
End Sub
Sub MakeChanges()
Dim RowNum As Long
Dim Cls As Designer.Class
Dim Obj As Designer.Object
Dim Cond As Designer.PredefinedCondition
Dim Rng As Excel.Range
Set DesignerApp = New Designer.Application
DesignerApp.Visible = True
Call DesignerApp.LogonDialog
Set Univ = DesignerApp.Universes.Open
Set Wksht = ThisWorkbook.Worksheets("Objects")
Set Rng = Wksht.Range("Objects")
For RowNum = 1 To Rng.Rows.Count
Set Cls = Univ.Classes.FindClass(Rng.Cells(RowNum, 1).Value)
Set Obj = Cls.Objects(Rng.Cells(RowNum, 2).Value)
If Obj.Name <> Rng.Cells(RowNum, 4) Then Obj.Name = Rng.Cells(RowNum, 4)
Obj.Description = Rng.Cells(RowNum, 5)
Next RowNum
' -------- added by Marek Chladny ------
Set Wksht = ThisWorkbook.Worksheets("Classes")
Set Rng = Wksht.Range("Classes")
For RowNum = 1 To Rng.Rows.Count
If Rng.Cells(RowNum, 1) <> Rng.Cells(RowNum, 3) Or Rng.Cells(RowNum, 2) <> Rng.Cells(RowNum, 4) Then
Set Cls = Univ.Classes.FindClass(Rng.Cells(RowNum, 1).Value)
Cls.Name = Rng.Cells(RowNum, 3)
Cls.Description = Rng.Cells(RowNum, 4)
End If
Next RowNum
' --------------------------------------
' -------- added by Romain Jubert ------
Set Wksht = ThisWorkbook.Worksheets("Conditions")
Set Rng = Wksht.Range("Conditions")
For RowNum = 1 To Rng.Rows.Count
Set Cls = Univ.Classes.FindClass(Rng.Cells(RowNum, 1).Value)
Set Cond = Cls.PredefinedConditions(Rng.Cells(RowNum, 2).Value)
If Cond.Name <> Rng.Cells(RowNum, 4) Then Cond.Name = Rng.Cells(RowNum, 4)
Cond.Description = Rng.Cells(RowNum, 5)
Next RowNum
' --------------------------------------
Set Obj = Nothing
Set Cond = Nothing
Set Cls = Nothing
Set Rng = Nothing
Set Wksht = Nothing
Set Univ = Nothing
Set DesignerApp = Nothing
End Sub
Private Sub GetObjectInfo(Clss, RowNum As Long)
Dim Cls As Designer.Class
Dim Obj As Designer.Object
For Each Cls In Clss
For Each Obj In Cls.Objects
RowNum = RowNum + 1
Wksht.Cells(RowNum, 1) = Cls.Name
Wksht.Cells(RowNum, 2) = Obj.Name
Wksht.Cells(RowNum, 3) = Obj.Description
Next Obj
If Cls.Classes.Count > 0 Then
Call GetObjectInfo(Cls.Classes, RowNum)
End If
Range("Objects").Resize(RowNum - 1, 5).Name = "Objects" ' added by Marek Chladny
Next Cls
End Sub
Private Sub GetClassInfo(Clss, RowNum As Long) ' added by Marek Chladny
Dim Cls As Designer.Class
For Each Cls In Clss
RowNum = RowNum + 1
Wksht.Cells(RowNum, 1) = Cls.Name
Wksht.Cells(RowNum, 2) = Cls.Description
If Cls.Classes.Count > 0 Then
Call GetClassInfo(Cls.Classes, RowNum)
End If
Range("Classes").Resize(RowNum - 1, 4).Name = "Classes"
Next Cls
End Sub
Private Sub GetPredefinedConditionInfo(Clss, RowNum As Long) ' added by Romain Jubert
Dim Cls As Designer.Class
Dim Cond As Designer.PredefinedCondition
For Each Cls In Clss
For Each Cond In Cls.PredefinedConditions
RowNum = RowNum + 1
Wksht.Cells(RowNum, 1) = Cls.Name
Wksht.Cells(RowNum, 2) = Cond.Name
Wksht.Cells(RowNum, 3) = Cond.Description
Next Cond
If Cls.Classes.Count > 0 Then
Call GetPredefinedConditionInfo(Cls.Classes, RowNum)
End If
Range("Conditions").Resize(RowNum - 1, 5).Name = "Conditions" ' added by Marek Chladny
Next Cls
End Sub
Universe - Object, Class and Predefined Conditions - Names & Descriptions.zip (23.0 KB)
Romain J (BOB member since 2010-07-28)
(BOB member since 2003-11-27)