Submodel Report.bas.htm

      'TITLE:  SUBMODEL REPORT
      'DESCRIPTION:  This report generates a list of entities and their
      '  submodels for the active model.  The output is an excel spread
      '  sheet.
      'AUTHOR:  Jason Tiret
      'DATE:    3/25/2004
      
      ' declare ERStudio variables
      Dim Diag As Diagram
      Dim Entdisp As EntityDisplay
      Dim Mdl As Model
      Dim submdl As SubModel
      Dim so As SelectedObject
      
      ' declare Excel variables
      Dim Excel As Object
      
      Dim curRow As Integer
      Dim curCol As Integer
      Dim clrBack As Variant
      Dim clrFore As Variant
      Dim clrTitleBack As Variant
      Dim clrTitleFore 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)
      
      Dim main_model_list () As String
      
      
      Sub Main
      
      	' Init the ER/Studio variables.
      
      	Set Diag = DiagramManager.ActiveDiagram
      	Set Mdl = Diag.ActiveModel
      	Set submdl = Mdl.ActiveSubModel
      
      	Set Excel = CreateObject("Excel.Application")
      	Excel.Workbooks.Add
      
      	curRow = 1
      	curCol = 1
      
      	clrBack = CLR_WHITE
      	clrFore = CLR_BLACK
      	clrTitleBack = CLR_GREY
      	clrTitleFore = CLR_BLACK
      
      
      	InitColumnWidth
      	PrintColumnHeader
      	PrintData
      
      	MsgBox("Export   Complete!",,"ER/Studio")
      
      	' make Excel spread sheet visible
      	Excel.Visible = True
      
      End Sub
      
      
      Sub PrintData
      
      	Dim bHideFont As Boolean
      	bHideFont = False
      
      	For Each submdl In Mdl.SubModels
      
      		For Each Entdisp In submdl.EntityDisplays
      
      			PrintRecord
      
      		Next
      
      	Next
      
      
      End Sub
      
      'this routine is called by PrintData to right one record to the spread sheet.
      'there are no parameters associated with it.  The diagram variables are initialized
      'with in the Sub Main routine.
      Sub PrintRecord
      
      
      	'output the submodel name to the spread sheet
      	PrintCell submdl.Name, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
      
      	'Output logical entity name to spread sheet
      	PrintCell Entdisp.ParentEntity.EntityName, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
      
      	'output physical table name to spread sheet
      	PrintCell Entdisp.ParentEntity.TableName, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
      
      	'output entity definition to spread sheet
      	PrintCell Entdisp.ParentEntity.Definition, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
      
      	curRow = curRow + 1
      	curCol = 1
      
      End Sub
      
      
      ' Initialize the column width.
      
      Sub InitColumnWidth
      
      	Dim count As Integer
      
      	count = 4
      
      
      	'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
      
      
      		PrintCell "Submodel", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      
      		PrintCell "Entity Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      
      		PrintCell "Table Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      
      		PrintCell "Entity/Table Definition", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 12, True
      
      
      		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