Export Model Metadata to Excel

      'MACRO TITLE: EXPORT MODEL METADATA TO EXCEL
      'This macro generates a report for the active model in ER/Studio.
      ' REQUIREMENT: You must have MS Excel 97 installed
      
      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 ent As Entity
      Dim attr As AttributeObj
      
      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
      	' Start Excel and make it visible.
      	
      	Set Excel = CreateObject("Excel.Application")
      	Excel.Visible = True
      	Excel.Workbooks.Add
      
      	' Init the ER/Studio variables.
      	
      	Set diag = DiagramManager.ActiveDiagram
      	Set mdl = diag.ActiveModel
      
      	curRow = 1
      	curCol = 1
      
      	' Prompt the user.
      	
      	Begin Dialog UserDialog 150,140,"Report Type" ' %GRID:10,7,1,1
      		OptionGroup .Group1
      			OptionButton 20,7,130,21,"Simple",.OptionButton1
      			OptionButton 20,35,130,21,"Colorful",.OptionButton2
      		OKButton 20,98,90,28
      	End Dialog
      	Dim dlg As UserDialog
      	Dialog dlg
      	
      	If dlg.Group1 = 0 Then
      		clrBack = CLR_WHITE
      		clrFore = CLR_BLACK
      		clrTitleBack = CLR_GREY
      		clrTitleFore = CLR_BLACK
      	Else
      		clrBack = CLR_TEAL
      		clrFore = CLR_BLACK
      		clrTitleBack = CLR_BLACK
      		clrTitleFore = CLR_WHITE
      	End If
      	
      	' Print the spread sheet.
      
      	InitColumnWidth
      	PrintReportHeader mdl.Name
      	PrintColumnHeader ColOrder
      	PrintData
      
      	Excel.Visible = True
      End Sub
      
      Sub PrintData
      	Dim bHideFont As Boolean
      	bHideFont = False
      
      	For Each ent In mdl.Entities
      		For Each attr In ent.Attributes
      			If bHideFont = True Then
      				PrintCell ent.TableName, "", curRow, curCol, 0, 1, clrBack, clrBack, 10, True
      			Else
      				PrintCell ent.TableName, ent.Definition, curRow, curCol, 0, 1, clrFore, clrBack, 10, True
      			End If
      	
      			bHideFont = True
      
      			PrintCell attr.ColumnName, attr.Definition, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      			If (attr.DataLength <> "-1") Then
      				PrintCell attr.Datatype & " (" & attr.DataLength & ")", "", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      			Else
      				PrintCell attr.Datatype, "", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      			End If
      			PrintCell attr.NullOption, "", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
      			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
      
      			If (attr.ForeignKey = "True") Then
      				PrintCell "Yes", "", curRow, curCol, 1, -5, clrFore, clrBack, 10, False
      			Else
      				PrintCell "No", "", curRow, curCol, 1, -5, clrFore, clrBack, 10, False
      			End If
      		Next
      		
      		curCol = 1
      		bHideFont = False
      	Next
      	
      	With Excel
      		.Range(.Cells(4, 1), .Cells(curRow, 6)).Sort .Cells(4, 1)
      		If clrBack <> CLR_WHITE Then
      			.Range(.Cells(4, 1), .Cells(curRow, 6)).Interior.color = clrBack
      		End If
      	End With
      
      End Sub
      
      ' Initialize the column width.
      
      Sub InitColumnWidth
      	Excel.Cells(1, 1).ColumnWidth = 25
      	Excel.Cells(1, 2).ColumnWidth = 25
      	Excel.Cells(1, 3).ColumnWidth = 20
      	Excel.Cells(1, 4).ColumnWidth = 25
      	Excel.Cells(1, 5).ColumnWidth = 15
      	Excel.Cells(1, 6).ColumnWidth = 15
      End Sub
      
      ' Print the report header.
      
      Sub PrintReportHeader(ModelName As String)
      	With Excel.Cells(curRow, curCol)
      		.Value = ModelName & " Model Table and Column Report"
      		.Font.Italic = True
      		.Font.Bold = True
      		.Font.Size = 18
      	End With
      	
      	curRow = curRow + 2
      	
      	With Excel
      		.Range(.Cells(1, 1), .Cells(curRow, 6)).Font.Color = clrTitleFore
      		.Range(.Cells(1, 1), .Cells(curRow, 6)).Interior.Color = clrTitleBack
      	End With
      End Sub
      
      ' Print the column header.
      
      Sub PrintColumnHeader(ColOrder As Variant)
      	PrintCell "Table Name", "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      	PrintCell "Column Name", "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      	PrintCell "Column Datatype", "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      	PrintCell "Column Null Option", "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      	PrintCell "Primary Key", "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      	PrintCell "Foreign Key", "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      
      	curRow = curRow + 1
      	curCol = 1
      End Sub
      
      ' Print a cell
      
      Sub PrintCell(value As String, note 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
      	
      	If (note <> "") Then
      		Excel.Cells(row, col).NoteText note
      	End If
      	
      	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