'MACRO TITLE: EXPORT MODEL METADATA TO EXCEL VERSION 2.1
' This macro generates a report for the active model in ER/Studio.
' REQUIREMENT: You must have MS Excel 97 or later installed
' UPDATED ON 9/30/2004
' Updates include the option to export for selected objects or the main
' model and the include of attribute notes.
Dim curRow As Integer
Dim curCol As Integer
Dim clrBack As Variant
Dim clrFore As Variant
Dim clrTitleBack As Variant
Dim clrTitleFore As Variant
' dim dialog variables
Dim selected_object_loop As Boolean 'if true, macro loops through selected objects
'if false, macro loops through all objects
' Dim MS Excel variables.
Dim Excel As Object
' Dim ER/Studio variables.
Dim diag As Diagram
Dim mdl As Model
Dim submdl As SubModel
Dim so As SelectedObject
Dim ent As Entity
Dim attr As AttributeObj
Dim rel As Relationship
Dim eNames As Variant
Dim eCount As Variant
Dim entdisplay As EntityDisplay
Public Const CLR_WHITE = RGB(255, 255, 255)
Public Const CLR_BLACK = RGB(0, 0, 0)
Public Const CLR_GREY = RGB(192, 192, 192)
Public Const CLR_TEAL = RGB(0, 128, 128)
Sub Main
' Init the ER/Studio variables.
Set diag = DiagramManager.ActiveDiagram
Set mdl = diag.ActiveModel
Set submdl = mdl.ActiveSubModel
curRow = 1
curCol = 1
Debug.Clear
' Prompt the user.
Begin Dialog UserDialog 970,406,"Excel Export Options",.ExportHandler ' %GRID:10,7,1,1
GroupBox 20,112,320,273,"Entity/Table Options",.GroupBox1
CheckBox 50,140,110,14,"Entity Name",.EntityName
CheckBox 50,168,110,14,"Table Name",.TableName
CheckBox 50,196,180,14,"Entity/Table Definition",.ETdefinition
GroupBox 370,112,570,224,"Attribute Options",.GroupBox2
CheckBox 390,140,140,14,"Attribute Name",.AttributeName
CheckBox 390,168,120,14,"Column Name",.ColumnName
CheckBox 390,196,210,14,"Attribute/Column Definition",.ACdefinition
CheckBox 390,280,280,14,"Data Type (includes precision and scale)",.Datatype
CheckBox 390,308,110,14,"Null Option",.NullOption
CheckBox 680,140,220,14,"Primary Key Property (Boolean)",.PKproperty
CheckBox 680,168,220,14,"Foreign Key Property (Boolean)",.FKproperty
CheckBox 680,259,160,14,"Column Default",.columndefault
CheckBox 680,287,190,14,"Column Check Constraint",.CheckConstraint
CheckBox 680,203,240,14,"Has Logical Rolename (Boolean)",.HasLogicalRoleName
CheckBox 680,231,200,14,"Has Rolename (Boolean)",.HasRoleName
CheckBox 400,357,160,14,"Only Key Columns",.keycolumns
CheckBox 390,252,180,14,"Domain",.Domain
PushButton 660,322,90,21,"Select All",.attrselect
PushButton 790,322,90,21,"Deselect All",.attrdeselect
CheckBox 50,273,90,14,"Owner",.Owner
CheckBox 50,301,200,14,"Storage Location",.StorageLocation
CheckBox 50,336,90,14,"Database",.Database
Text 80,315,240,14,"(i.e., Table Space, filegroup, segment)",.Text1
Text 80,350,90,14,"(for OS/390)",.Text2
PushButton 120,371,90,21,"Select All",.tblselect
PushButton 230,371,90,21,"Deselect All",.tbldeselect
Text 30,252,230,14,"Physical table properties:",.Text3
Text 20,7,150,14,"Diagram Information:",.diaginfotxt
GroupBox 600,21,240,77,"Export Scope",.GroupBox3
OptionGroup .object_sel
OptionButton 650,42,130,14,"All Objects",.OptionButton3
OptionButton 650,70,140,14,"Selected Objects",.OptionButton4
CheckBox 390,224,210,14,"Attribute/Column Note",.ACnote
OKButton 590,357,160,35
CancelButton 780,357,150,35
TextBox 20,28,560,70,.diag_info,1
CheckBox 50,224,210,14,"Entity/Table Note",.ETNote
End Dialog
Dim dlg As UserDialog
'initialize the dialog info text block.
Dim sel_objects As String
Dim mdl_type As String
If entitiesSelected = False Then
sel_objects = "NO"
Else
sel_objects = "YES"
End If
If mdl.Logical = True Then
mdl_type = "LOGICAL"
Else
mdl_type = "PHYSICAL"
End If
'populate text box in the dialog with some information about what will be exported
dlg.diag_info = "Diagram: " & diag.ProjectName & vbCrLf & "Model Name: " & mdl.Name & vbCrLf & "Model Type: " & mdl_type & vbCrLf & "Active Model: " & submdl.Name & vbCrLf & "Selected Objects: " & sel_objects
clrBack = CLR_WHITE
clrFore = CLR_BLACK
clrTitleBack = CLR_GREY
clrTitleFore = CLR_BLACK
' Print the spread sheet.
If Dialog(dlg) = -1 Then
' Start Excel and make it visible.
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Excel.Workbooks.Add
ReDim EntDialogOptions ( 1 To 21 ) As Boolean
'build array of Entity options to pass to Printdata subroutine
EntDialogOptions(1) = dlg.EntityName
EntDialogOptions(2) = dlg.TableName
EntDialogOptions(3) = dlg.ETdefinition
EntDialogOptions(21) = dlg.ETNote
EntDialogOptions(4) = dlg.Owner
EntDialogOptions(5) = dlg.StorageLocation
EntDialogOptions(6) = dlg.Database
EntDialogOptions(7) = dlg.AttributeName
EntDialogOptions(8) = dlg.ColumnName
EntDialogOptions(9) = dlg.ACdefinition
EntDialogOptions(20) = dlg.ACnote
EntDialogOptions(10) = dlg.Domain
EntDialogOptions(11) = dlg.Datatype
EntDialogOptions(12) = dlg.NullOption
EntDialogOptions(13) = dlg.PKproperty
EntDialogOptions(14) = dlg.FKProperty
EntDialogOptions(15) = dlg.columndefault
EntDialogOptions(16) = dlg.CheckConstraint
EntDialogOptions(17) = dlg.HasLogicalRoleName
EntDialogOptions(18) = dlg.HasRoleName
EntDialogOptions(19) = dlg.keycolumns
InitColumnWidth EntDialogOptions
PrintColumnHeader ColOrder, EntDialogOptions
PrintData EntDialogOptions
Excel.Visible = True
End If 'dialog
End Sub
Sub PrintData (EntOptions As Variant)
Dim count As Integer
Dim JustEntityInfo As Boolean
count = 1
'count the true values from the dialog array so that the correct number
'of columns are printed out
For i = 1 To 21
Debug.Print EntOptions(i)
If EntOptions(i) = True Then
count = count + 1
End If
Next
JustEntityInfo = True
'determine if only entity info is printed out so that entity names and
'definitions are only printed once.
For j = 7 To 20
If EntOptions(j) = True Then
JustEntityInfo = False
Exit For
End If
Next j
If selected_object_loop = False Then
'loop through all objects in the model
For Each entdisplay In submdl.EntityDisplays
Set ent = entdisplay.ParentEntity
'If JustEntityInfo is true, then no attribute info is exported
'so table/entity names and table definitions only have to be printed once
If JustEntityInfo = True Then
printRecord_entOnly EntOptions
curRow = curRow + 1
curCol = 1
Else
For j = 1 To ent.Attributes.Count
For Each attr In ent.Attributes
If attr.SequenceNumber = j Then
If EntOptions(19) = False Then
GoTo SKIP
End If
If attr.PrimaryKey = True Or attr.ForeignKey = True Then
SKIP:
printRecord_ent_and_attr EntOptions
curRow = curRow + 1
curCol = 1
End If ' key column check
End If 'sequence number check
Next attr
Next j
End If 'Just entity information check
curCol = 1
Next entdisplay
Else
'Only report on selected entities
For Each so In submdl.SelectedObjects
If so.Type = 1 Then
Set ent = mdl.Entities.Item(so.ID)
'If JustEntityInfo is true, then no attribute info is exported
'so table/entity names and table definitions only have to be printed once
If JustEntityInfo = True Then
printRecord_entOnly EntOptions
curRow = curRow + 1
curCol = 1
Else
For j = 1 To ent.Attributes.Count
For Each attr In ent.Attributes
If attr.SequenceNumber = j Then
If EntOptions(19) = False Then
GoTo SKIP2
End If
If attr.PrimaryKey = True Or attr.ForeignKey = True Then
SKIP2:
printRecord_ent_and_attr EntOptions
curRow = curRow + 1
curCol = 1
End If ' key column check
End If 'sequence number check
Next attr
Next j
End If 'Just entity information check
curCol = 1
End If 'so ID check
Next so
End If ' selected object check
End Sub
Function printRecord_entOnly(EntOptions As Variant)
'print entity name if option is true
If EntOptions(1) = True Then
PrintCell ent.EntityName, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print table name if option is true
If EntOptions(2) = True Then
PrintCell ent.TableName, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print entity definition if option is true
If EntOptions(3) = True Then
PrintCell ent.Definition, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
If EntOptions(21) = True Then
PrintCell ent.Note, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
End If
'print entity owner if option is true
If EntOptions(4) = True Then
PrintCell ent.Owner, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print entity storage location if option is true
If EntOptions(5) = True Then
PrintCell ent.StorageLocation, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print entity definition if option is true
If EntOptions(6) = True Then
PrintCell ent.DatabaseLocation, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
End Function
Function printRecord_ent_and_attr(EntOptions As Variant)
'print entity name if option is true, use fore color
If EntOptions(1) = True Then
PrintCell ent.EntityName, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print table name if option is true, use fore color
If EntOptions(2) = True Then
PrintCell ent.TableName, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print entity/table definition if option is true, use fore color
If EntOptions(3) = True Then
PrintCell ent.Definition, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
If EntOptions(21) = True Then
PrintCell ent.Note, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
End If
'print entity owner if option is true
If EntOptions(4) = True Then
PrintCell ent.Owner, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print entity storage location if option is true
If EntOptions(5) = True Then
PrintCell ent.StorageLocation, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print entity definition if option is true
If EntOptions(6) = True Then
PrintCell ent.DatabaseLocation, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print attribute name if option is true
If EntOptions(7) = True Then
Dim attrname As String
If attr.HasLogicalRoleName = True Then
attrname = attr.LogicalRoleName
Else
attrname = attr.AttributeName
End If
PrintCell attrname, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print column name if option is true
If EntOptions(8) = True Then
Dim colname As String
If attr.HasRoleName = True Then
colname = attr.RoleName
Else
colname = attr.ColumnName
End If
PrintCell colname, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print attribute definition if option is true
If EntOptions(9) = True Then
PrintCell attr.Definition, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print attribute note if option is true
If EntOptions(20) = True Then
PrintCell attr.Notes, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print attribute domain if option is true
If EntOptions(10) = True Then
Dim dom As Domain
If attr.DomainId <> 0 Then
Set dom = diag.Domain(attr.DomainId)
PrintCell dom.Name, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
Else
PrintCell "", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
End If
'print attribute datatype if option is true
If EntOptions(11) = True Then
Dim datatype As String
datatype = attr.CompositeDatatype
datatype = Replace(datatype, " NOT", "")
datatype = Replace(datatype, " NULL", "")
PrintCell datatype, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print null option if option is true
If EntOptions(12) = True Then
PrintCell attr.NullOption, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print yes or no depending on whether the attribute is a primary key if option is true
If EntOptions(13) = True Then
If (attr.PrimaryKey = "True") Then
PrintCell "Yes", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
Else
PrintCell "No", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If 'primary key check
End If 'primary option
'print yes or no depending on whether the attribute is a foreign key if option is true
If EntOptions(14) = True Then
If (attr.ForeignKey = "True") Then
PrintCell "Yes", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
Else
PrintCell "No", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If 'foreign key check
End If 'foreign option
If EntOptions(17) = True Then
If (attr.HasLogicalRoleName = "True") Then
PrintCell "Yes", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
Else
PrintCell "No", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If 'Logical rolename check
End If 'logical rolename option
If EntOptions(18) = True Then
If (attr.HasRoleName = "True") Then
PrintCell "Yes", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
Else
PrintCell "No", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If 'rolename check
End If 'rolename option
'print default if option is checked
If EntOptions(15) = True Then
PrintCell attr.DeclaredDefault, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
'print check constraint if option is checked
If EntOptions(16) = True Then
PrintCell attr.CheckConstraint, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
End If
End Function
' Initialize the column width.
Sub InitColumnWidth (options As Variant)
Dim count As Integer
count = 0
'count the number of true options
For i = 1 To 21
If options(i) = True Then
count = count + 1
End If
Next i
'initialize column widths
For j = 1 To count
Excel.Cells(1, j).ColumnWidth = 30
Next j
End Sub
' Print the column header. Only print headers when value is true in options array.
Sub PrintColumnHeader(ColOrder As Variant, options As Variant)
If options(1) = True Then
PrintCell "Entity Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(2) = True Then
PrintCell "Table Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(3) = True Then
PrintCell "Entity/Table Definition", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(21) = True Then
PrintCell "Entity/Table Note", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(4) = True Then
PrintCell "Entity/Table Owner", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(5) = True Then
PrintCell "Storage Location", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(6) = True Then
PrintCell "Database", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(7) = True Then
PrintCell "Attribute Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(8) = True Then
PrintCell "Column Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(9) = True Then
PrintCell "Attribute/Column Definition", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(20) = True Then
PrintCell "Attribute/Column Note", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(10) = True Then
PrintCell "Domain", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(11) = True Then
PrintCell "Column Datatype", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(12) = True Then
PrintCell "Column Null Option", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(13) = True Then
PrintCell "Primary Key", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(14) = True Then
PrintCell "Foreign Key", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(17) = True Then
PrintCell "Logical Rolename", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(18) = True Then
PrintCell "Rolename", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(15) = True Then
PrintCell "Column Default", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
If options(16) = True Then
PrintCell "Column Check Constraint", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
End If
curRow = curRow + 1
curCol = 1
End Sub
Function entitiesSelected() As Boolean
Dim selObj As SelectedObject
If submdl.SelectedObjects.Count > 0 Then
For Each selObj In submdl.SelectedObjects
If selObj.Type=1 Then
entitiesSelected = True
Exit Function
End If
Next
End If
entitiesSelected = False
End Function
' Print a cell
Sub PrintCell(value As String, row As Integer, col As Integer, rowInc As Integer, colInc As Integer, clrFore As Variant, clrBack As Variant, szFont As Integer, bBold As Boolean)
Excel.Cells(row, col).Value = value
Excel.Cells(row, col).Font.Bold = bBold
Excel.Cells(row, col).Font.Color = clrFore
Excel.Cells(row, col).Font.Size = szFont
curRow = curRow + rowInc
curCol = curCol + colInc
End Sub
Rem See DialogFunc help topic for more information.
Private Function ExportHandler(DlgItem$, Action%, SuppValue&) As Boolean
Select Case Action%
Case 1 ' Dialog box initialization
If entitiesSelected = False Then
DlgEnable "OptionButton4", False
Else
DlgEnable "optionbutton4", True
End If
Case 2 ' Value changing or button pressed
If DlgItem = "OK" Then
Debug.Print mdl.DatabasePlatform
Dim DBplatform As String
DBplatform = Left(mdl.DatabasePlatform,22)
If (DlgValue("StorageLocation") = 1 Or DlgValue("Database") = 1 Or DlgValue("Owner") = 1) And mdl.Logical = True Then
MsgBox ("Physical table properties can only be selected for physical models.",,"MESSAGE")
ExportHandler = True
ElseIf DBplatform <> "IBM DB2 UDB for OS/390" And DlgValue("Database") = 1 Then
MsgBox ("Database option is only for DB2 OS/390 physical models.",,"MESSAGE")
ExportHandler = True
End If
ElseIf DlgItem = "tblselect" Then
DlgValue "EntityName", 1
DlgValue "TableName", 1
DlgValue "ETdefinition", 1
DlgValue "ETNote", 1
DlgValue "Owner", 1
DlgValue "StorageLocation", 1
DlgValue "Database", 1
ExportHandler = True
ElseIf DlgItem = "tbldeselect" Then
DlgValue "EntityName", 0
DlgValue "TableName", 0
DlgValue "ETdefinition", 0
DlgValue "ETNote", 0
DlgValue "Owner", 0
DlgValue "StorageLocation", 0
DlgValue "Database", 0
ExportHandler = True
ElseIf DlgItem = "attrselect" Then
DlgValue "AttributeName", 1
DlgValue "ColumnName", 1
DlgValue "ACdefinition", 1
DlgValue "ACNote", 1
DlgValue "Domain", 1
DlgValue "Datatype", 1
DlgValue "NullOption", 1
DlgValue "PKproperty", 1
DlgValue "FKProperty", 1
DlgValue "columndefault", 1
DlgValue "CheckConstraint", 1
DlgValue "HasLogicalRoleName", 1
DlgValue "HasRoleName", 1
ExportHandler = True
ElseIf DlgItem = "attrdeselect" Then
DlgValue "AttributeName", 0
DlgValue "ColumnName", 0
DlgValue "ACdefinition", 0
DlgValue "ACNote", 0
DlgValue "Domain", 0
DlgValue "Datatype", 0
DlgValue "NullOption", 0
DlgValue "PKproperty", 0
DlgValue "FKProperty", 0
DlgValue "columndefault", 0
DlgValue "CheckConstraint", 0
DlgValue "HasLogicalRoleName", 0
DlgValue "HasRoleName", 0
ExportHandler = True
ElseIf DlgItem = "object_sel" Then
selected_object_loop = DlgValue("object_sel")
Debug.Print "selected_object_loop = " & selected_object_loop
End If
Rem ExportHandler = True ' Prevent button press from closing the dialog box
Case 3 ' TextBox or ComboBox text changed
Case 4 ' Focus changed
Case 5 ' Idle
Rem ExportHandler = True ' Continue getting idle actions
Case 6 ' Function key
End Select
End Function