'MACRO TITLE: EXPORT INDEX COLUMN INFO TO EXCEL.BAS
      'This macro generates an index column report for the active
      'model in ER/Studio.  Each record in the Excel spread sheet
      'represents an indexed column.  The spread sheet can be used
      'to apply naming conventions to indexes.  The new index name
      'can be read in with the "Import Index Names from Excel" macro
      'from the "New Index Name" column in the spread sheet.
      '	REQUIREMENT: You must have MS Excel 97 or later installed
      'AUTHOR:  Jason Tiret
      'CONTACT:  http://support.embarcadero.com/
      'LAST UPDATE:  5/6/2003
      
      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 entdisp As EntityDisplay
      Dim indx As Index
      Dim indxcol As IndexColumn
      
      
      
      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
      
      
      	clrBack = CLR_WHITE
      	clrFore = CLR_BLACK
      	clrTitleBack = CLR_GREY
      	clrTitleFore = CLR_BLACK
      
      	
      
      
      	' Create Excel workbook.
      	
      	Set Excel = CreateObject("Excel.Application")
      	Excel.Workbooks.Add
      
      
      
      
      	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
      
      
      
      		'loop through entity displays of the current submodel
      		For Each entdisp In submdl.EntityDisplays
      
      			'get the entity object from the entity display object
      			Set ent = entdisp.ParentEntity
      
      				'loop through the indexes of the entity
      				For Each indx In ent.Indexes
      
      					'loop through the indexed columns of the index
      					For Each indxcol In indx.IndexColumns
      
      						'Print the table name
      						PrintCell ent.TableName, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
      						'Print the index name
      						PrintCell indx.Name, curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
      						'determine the type of the index and print it to the spread sheet
      						Select Case UCase(indx.KeyType)
      
        							Case "P"  'Primary
      
        								PrintCell "PK", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
         							Case "I"  'Inversion Entry or Non-unique index
      
         								PrintCell "IE", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
          						Case "A"  'Alternate Key or Unique index
      
          							PrintCell "AK", curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
      
         						End Select
      
      
      						'print the column name of the indexed column
      						PrintCell indxcol.ColumnName , curRow, curCol, 0, 1, clrFore, clrBack, 10, False
      
      						'increment the row counter for the next row in the spread sheet
      						curRow = curRow + 1
      						curCol = 1
      						bHideFont = False
      
      					Next
      
      
      				Next
      
      		
      		Next
      
      
      End Sub
      
      ' Initialize the column width.
      
      Sub InitColumnWidth
      
      Dim count As Integer
      
      count = 5
      
      
      'initialize column widths
      For j = 1 To count
      	Excel.Cells(1, j).ColumnWidth = 20
      Next j
      
      End Sub
      
      ' Print the column header.  Only print headers when value is true in options array.
      
      Sub PrintColumnHeader
      
      
      		PrintCell "Table Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
      
      		PrintCell "Index Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
      
      		PrintCell "Index Type", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
      
      		PrintCell "Index Member Column Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
      
      		PrintCell "New Index Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, 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
      
      

     
  • No labels