'MACRO TITLE: EXPORT MODEL METADATA TO EXCEL VERSION 2 ' This macro generates a report for the active model in ER/Studio. ' REQUIREMENT: You must have MS Excel 97 or later installed ' PLEASE NOTE: This macro only reports on the selected entities! ' UPDATED: 9/18/03 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 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 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 950,301,"Excel Export Options",.ExportHandler ' %GRID:10,7,1,1 OKButton 580,259,150,35 CancelButton 760,259,150,35 GroupBox 20,14,320,245,"Entity/Table Export Options",.GroupBox1 CheckBox 50,42,110,14,"Entity Name",.EntityName CheckBox 50,70,110,14,"Table Name",.TableName CheckBox 50,98,180,14,"Entity/Table Definition",.ETdefinition GroupBox 360,14,570,224,"Attribute Options",.GroupBox2 CheckBox 390,42,140,14,"Attribute Name",.AttributeName CheckBox 390,70,120,14,"Column Name",.ColumnName CheckBox 390,98,210,14,"Attribute/Column Definition",.ACdefinition CheckBox 390,154,280,14,"Data Type (includes precision and scale)",.Datatype CheckBox 390,182,110,14,"Null Option",.NullOption CheckBox 680,42,220,14,"Primary Key Property (Boolean)",.PKproperty CheckBox 680,70,220,14,"Foreign Key Property (Boolean)",.FKproperty CheckBox 680,154,160,14,"Column Default",.columndefault CheckBox 680,182,190,14,"Column Check Constraint",.CheckConstraint CheckBox 680,98,240,14,"Has Logical Rolename (Boolean)",.HasLogicalRoleName CheckBox 680,126,200,14,"Has Rolename (Boolean)",.HasRoleName CheckBox 460,210,160,14,"Only Key Columns",.keycolumns CheckBox 390,126,180,14,"Domain",.Domain PushButton 660,224,90,21,"Select All",.attrselect PushButton 770,224,90,21,"Deselect All",.attrdeselect CheckBox 50,147,90,14,"Owner",.Owner CheckBox 50,175,200,14,"Storage Location",.StorageLocation CheckBox 50,210,90,14,"Database",.Database Text 80,189,240,14,"(i.e., Table Space, filegroup, segment)",.Text1 Text 90,224,90,14,"(for OS/390)",.Text2 PushButton 110,245,90,21,"Select All",.tblselect PushButton 220,245,90,21,"Deselect All",.tbldeselect Text 30,126,230,14,"Physical table properties:",.Text3 End Dialog Dim dlg As UserDialog 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 19 ) 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(4) = dlg.Owner EntDialogOptions(5) = dlg.StorageLocation EntDialogOptions(6) = dlg.Database EntDialogOptions(7) = dlg.AttributeName EntDialogOptions(8) = dlg.ColumnName EntDialogOptions(9) = dlg.ACdefinition 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 If submdl.SelectedObjects.Count > 0 Then PrintColumnHeader ColOrder, EntDialogOptions PrintData EntDialogOptions Excel.Visible = True Else MsgBox "Please select an Entity. Or use Edit --> Select All." End If End If 'dialog End Sub Sub PrintData (EntOptions As Variant) Dim bHideFont As Boolean bHideFont = False 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 19 Debug.Print EntOptions(i) If EntOptions(i) = True Then count = count + 1 End If Next JustEntityInfo = False 'determine if only entity info is printed out so that entity names and 'definitions are only printed once. For j = 7 To 19 If EntOptions(j) = True Then JustEntityInfo = True Exit For End If Next j 'submdl.EntityNames(eNames, eCount) 'print entity and attribute info to excel 'For i = 0 To eCount - 1 'Set ent = mdl.Entities.Item(eNames(i)) '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 false, then no attribute info is exported 'so table/entity names and table definitions only have to be printed once If JustEntityInfo = False Then '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 '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 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: 'bHideFont is true to hide repeated entity and table names and table level defintions If bHideFont = True Then 'print entity name if option is true, use back color to hide repeated value If EntOptions(1) = True Then PrintCell ent.EntityName, curRow, curCol, 0, 1, clrBack, clrBack, 10, False End If 'print table name if option is true, use back color to hide repeated value If EntOptions(2) = True Then PrintCell ent.TableName, curRow, curCol, 0, 1, clrBack, clrBack, 10, False End If 'print entity level defintion if option is true, use back color to hide repeated value If EntOptions(3) = True Then PrintCell ent.Definition, curRow, curCol, 0, 1, clrBack, clrBack, 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 Else '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 '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 If bHideFont = True '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 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 curRow = curRow + 1 curCol = 1 End If End If Next attr Next End If curCol = 1 bHideFont = False End If Next so End Sub ' 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 18 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(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(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 ' 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 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 "Owner", 1 DlgValue "StorageLocation", 1 DlgValue "Database", 1 ExportHandler = True ElseIf DlgItem = "tbldeselect" Then DlgValue "EntityName", 0 DlgValue "TableName", 0 DlgValue "ETdefinition", 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 "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 "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 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