Couple of Macro requests? Automated View Generation/Metadata update / Data Model Metrics

Hello,

we are looking for a macro that can do the following:

1. Take each table in turn

2. Create a view based on the physical data model's table exact structure, with a specific pre-fix

Another one:

1. Can we have the Export Meta Data to Excel Version 3.1 extended to include the name of the Domain to which an attribute is bound?

Final One

Data Model Metrics:

Can we have a macro that produces the following metrics for all models in a DM1 file, split by model:

1) # of Entities

1b) # of Entities without definitions

2) # of attributes

2b) # of attributes without definitions

3) # of relationships

4) # of Primary, Alternate & Foreign Keys

Kind regards

Cheryl

  • Here's a macro that will create a basic view for all tables.  It'll add a suffix of _V but you can modify the macro to fit your needs.

    2287.Create basic views from all entities.txt
    'TITLE:  Create basic view for all entities
    
    'ER/Studio Variables
    Dim diag As Diagram
    Dim mdl As Model
    Dim submdl As SubModel
    
    Dim ent As Entity
    Dim entdisp As EntityDisplay
    
    Dim rel As Relationship
    Dim reldisp As RelationshipDisplay
    
    Dim vw As View
    Dim MyView As View
    Dim vwdisp As ViewDisplay
    
    
    
    Sub Main
    	Dim HorizPo As Integer
    	Dim VertPo As Integer
    
    	Dim MyDDL As String
    	Dim MyParentViewRelationship As ViewRelationships
    	Dim MyViewRelationship As ViewRelationship
    
    	Set diag = DiagramManager.ActiveDiagram
    	Set mdl = diag.ActiveModel
    	Set submdl = mdl.ActiveSubModel
    	Set MyParentViewRelationship = mdl.ViewRelationships
    
    	HorizPo = 100
    	VertPo = 100
    
    	For Each ent In mdl.Entities
    		Set MyView = mdl.Views.Add(HorizPo, VertPo)
    		MyView.Name = ent.TableName & "_V"
    		Set MyParentViewRelationship = MyView.ParentViewRelationships
    		MyParentViewRelationship.Add(ent.TableName,MyView.Name,False)
    
    	Next
    
    	
    End Sub
    

  • Here's a modified "Export Meta Data to Excel..." macro which includes domains.  

    3223.Export Meta Data to Excel Version 3.1 including Domains.txt
    'TITLE:  Export Meta Data to Excel Version 3
    'DESCRIPTION: This macro outputs model meta data to Excel in
    'a format which may be appealing for a finished report.
    'NOTES:
    '   Information will be exported for each entity/table that is
    '	selected prior to executing the macro.
    'DATE:  3/4/2002
    'LAST UPDATE: 10/29/2004
    
    
    '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 dict As Dictionary
    
    'dim excel variables
    Dim wb As Object
    Dim sheet As Object
    Dim excel As Object
    Dim selectedrange As Object
    
    
    
    Sub Main
    
    	Set diag = DiagramManager.ActiveDiagram
    	Set mdl = diag.ActiveModel
    	Set submdl = mdl.ActiveSubModel
    	Set dict = diag.Dictionary
    
    	Set excel = CreateObject("excel.application")
    	excel.visible = True
    
    	Dim curRow As Integer
    
    
    	PrintHeader
    	curRow = 4
    
    	If submdl.SelectedObjects.Count > 0 Then
    
    	For Each so In submdl.SelectedObjects
    
    		If so.Type = 1 Then
    
    			Set ent = mdl.Entities.Item(so.ID)
    
    			For Each attr In ent.Attributes
    
    				sheet.cells(curRow,1).Value = mdl.Name
    
    				sheet.cells(curRow,2).Value = submdl.Name
    
    				sheet.cells(curRow,3).Value = ent.EntityName
    
    				sheet.cells(curRow,4).Value = ent.TableName
    				
    				If attr.HasLogicalRoleName = True Then
    					sheet.cells(curRow,5).Value = attr.LogicalRoleName
    				Else
    					sheet.cells(curRow,5).Value = attr.AttributeName
    				End If
    
    				sheet.cells(curRow,6).Value = attr.Definition
    				sheet.cells(curRow,7).Value = attr.ColumnName
    
    				If attr.DomainId > 0 Then
    					sheet.cells(curRow, 8).Value = dict.Domains.Item(attr.DomainId).Name
    				End If
    
    				Dim Datastring As String
    
    				Datastring = attr.CompositeDatatype
    				Datastring = Replace(Datastring, " NOT", "")
    				Datastring = Replace(Datastring, " NULL", "")
    
    				If InStr(Datastring, "(") <> 0 Then
    					Datastring = Left(Datastring,InStr(Datastring, "(") - 1)
    				End If
    
    				sheet.cells(curRow,9).Value = Datastring
    
    				If attr.DataLength > 0 Then
    					sheet.cells(curRow,10).Value = attr.DataLength
    				End If
    
    				If attr.DataScale > 0 Then
    					sheet.cells(curRow,11).Value = attr.DataScale
    				End If
    
    				If NullOption(attr) = "N" Then
    					sheet.cells(curRow,13).Value = "OPTIONAL"
    				Else
    					sheet.cells(curRow,13).Value = "MANDATORY"
    				End If
    
    				sheet.cells(curRow,14).Value = NullOption(attr)
    				sheet.cells(curRow,15).Value = KeyOption(attr)
    				sheet.cells(curRow,16).Value = Identity_value(attr)
    
    				curRow = curRow + 1
    
    			Next
    
    		End If
    
    	Next
    
    	End If
    
    	
    End Sub
    
    Function Identity_value (att As AttributeObj ) As String
    
    	Dim Ident_val As String
    
    	If att.Identity = True Then
    
    		Ident_val = "YES"
    
    	Else
    
    		Ident_val = "NO"
    
    	End If
    
    	Identity_value = Ident_val
    
    End Function
    
    
    Function KeyOption ( att As AttributeObj ) As String
    
    	Dim keystr As String
    
    	If att.PrimaryKey = True Then
    
    		keystr = "(PK)"
    
    	End If
    
    	If att.ForeignKey = True Then
    
    		keystr = keystr & "(FK)"
    
    	End If
    
    	KeyOption = keystr
    
    End Function
    
    Function NullOption ( att As AttributeObj ) As String
    
    	Dim nullstr As String
    
    	If UCase(att.NullOption) = "NULL" Then
    
    		nullstr = "N"
    
    	End If
    
    	If UCase(att.NullOption) = "NOT NULL" Then
    
    		nullstr = "NN"
    
    	End If
    
    	If UCase(att.NullOption) = "NOT NULL" And att.DeclaredDefault <> "" Then
    
    		nullstr = "ND"
    
    	End If
    
    	NullOption = nullstr
    
    End Function
    
    
    Function Datatype ( DT As String ) As String
    	
    	Dim test As String
    
    	test = UCase(DT)
    
    	Select Case test
    
    		Case "DATE"
    			Datatype = "D"
    
    		Case "TIMESTAMP/DATE","TIMESTAMP","DATETIME","DATETIMN","SMALLDATETIME","TIME/DATETIME"
    			Datatype = "T"
    
    		Case "VARCHAR","VARCHAR2","NVARCHAR","CHAR","LONG VARCHAR","NTEXT/LONG VARCHAR","NCHAR","MLSLABEL/VARCHAR","ROWID/VARCHAR","BIT","BOOL","BOOLEAN","TEXT","IMAGE/LONG BINARY","IMAGE","BINARY","VARBINARY/BLOB","BLOB","CLOB"
    			Datatype = "C"
    
    		Case "ID","NUMERIC","NUMBER","DECIMAL","MONEY","SMALLMONEY","MONEYN","DECIMALN","PICTURE","FLOAT","SINGLE","REAL/SMALLFLOAT","FLOATN","NUMBER","DOUBLE","DOUBLE PRECISION","INTEGER","INT","INTN","SERIAL/INTEGER","COUNTER","UNIQUEID","SMALLINT","TINYINT"
    			Datatype = "N"
    
    		Case Else
    			datatyp = "C"
    	End Select
    
    End Function
    
    
    
    
    Sub PrintHeader
    
    	Set wb = excel.workbooks.Add
    	Set sheet = wb.activesheet
    
    	sheet.cells(1,1).Value = diag.ProjectName
    	sheet.cells(1,2).Value = diag.FileName
    	sheet.cells(2,1).Value = "=NOW()"
    	sheet.cells(2,1).Font.colorindex = 3
    	sheet.cells(1,1).Font.Size = 12
    	sheet.cells(1,2).Font.Size = 12
    	sheet.cells(1,1).Font.Bold = True
    	sheet.cells(1,2).Font.Bold = True
    
    
    	With sheet.range("A:R")
    			.WrapText = True
    			.cells.borders.colorindex = 1
    			.Font.Name = "ZapfHumnst BT"
    	End With
    
    
    	With sheet.range("A3:P3")
    		.interior.colorindex = 15
    		.Font.Bold = True
    		.Font.Size = 9
    	End With
    
    
    	With sheet.range("H:J")
    		.horizontalalignment = -4108
    	End With
    
    	sheet.Columns(10).horizontalalignment = -4108
    
    	sheet.Columns(1).columnwidth = 22.14
    	sheet.Columns(2).columnwidth = 22.14
    	sheet.Columns(3).columnwidth = 22.14
    	sheet.Columns(4).columnwidth = 16.29
    	sheet.Columns(5).columnwidth = 17.86
    	sheet.Columns(6).columnwidth = 52.14
    	sheet.Columns(7).columnwidth = 22.14
    	sheet.Columns(8).columnwidth = 14
    	sheet.Columns(9).columnwidth = 10.29
    	sheet.Columns(10).columnwidth = 10.29
    	sheet.Columns(11).columnwidth = 10.71
    	sheet.Columns(12).columnwidth = 23.43
    	sheet.Columns(13).columnwidth = 13
    	sheet.Columns(14).columnwidth = 11.71
    	sheet.Columns(15).columnwidth = 11.57
    	sheet.Columns(16).columnwidth = 11.57
    	sheet.Columns(17).columnwidth = 23.29
    
    
    	sheet.cells(3,1).Value = "MODEL NAME"
    	sheet.cells(3,2).Value = "SUBMODEL NAME"
    	sheet.cells(3,3).Value = "TABLE BUSINESS NAME"
    	sheet.cells(3,4).Value = "TABLE TECHNICAL NAME"
    	sheet.cells(3,5).Value = "COLUMN BUSINESS NAME"
    	sheet.cells(3,6).Value = "COLUMN BUSINESS DEFINITION"
    	sheet.cells(3,7).Value = "COLUMN TECHNICAL NAME"
    	sheet.cells(3,8).Value = "DOMAIN NAME"
    	sheet.cells(3,9).Value = "COLUMN DATA TYPE"
    	sheet.cells(3,10).Value = "TOTAL COLUMN LENGTH"
    	sheet.cells(3,11).Value = "# OF PLACES TO RIGHT OF DECIMAL"
    	sheet.cells(3,12).Value = "VALID VALUES"
    	sheet.cells(3,13).Value = "MANDATORY/ OPTIONAL         (Is Value Required)"
    	sheet.cells(3,14).Value = "N=NULL NN=Not Null ND=Not Null W/Default"
    	sheet.cells(3,15).Value = "Primary Key (PK)           Foreign Key (FK)"
    	sheet.cells(3,16).Value = "COLUMN IS AUTO-INCREMENTED (Identity)"
    	sheet.cells(3,17).Value = "Comments or Source Positions"
    
    	sheet.cells(4,17).Value = ""
    
    	With sheet.range("A3:P3")
    		.verticalalignment = -4160
    		.horizontalalignment = -4108
    	End With
    
    	sheet.Columns(15).horizontalalignment = 1
    
    	For i = 1 To 11
    
    		sheet.cells(1,i).borders(10).colorindex = -4142
    		sheet.cells(2,i).borders(10).colorindex = -4142
    
    	Next
    
    
    
    End Sub
    

  • Here's the last macro for the metrics.  I wasn't quite sure what you were looking for with the following:

    4) # of Primary, Alternate & Foreign Keys

    I didn't know if you were looking for the number of keys/indexes or the number of columns that are marked as PK/FKs or something else.  What I have done right now is count the number of keys/Indexes and display that.  I've also added the code to count the number of PK/FK columns but it's commented out.  Depending on what you're looking for you can comment/uncomment the following lines:
    For PK/FK column count:

                    ' count the number of key columns
                    'If attr.ForeignKey = True Or attr.PrimaryKey Then
                    '   totalKeys = totalKeys + 1
                    'End If

    For key/index count:

                ' count the number of keys/indexes
                totalKeys = totalKeys + ent.Indexes.Count

    Let me know if you have any questions.

    5531.Export Data Model Metrics to Excel .txt
    ' This macro will produces the following metrics report for all models in a DM1 file.
    ' This will export the following information in Excel where each one is a separate column:
    '
    ' 		Model Name
    '		# of Entities
    '		# of Entities without definitions
    '		# of Attributes
    '		# of Attributes without definitions
    '		# of Relationships
    '		# of Primary, Alternate & Foreign Keys
    
    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
    
    Sub Main
    
    	' Init the ER/Studio variables.
    	
    	Set diag = DiagramManager.ActiveDiagram
    	'Set dict = diag.Dictionary
    
    
    	curRow = 1
    	curCol = 1
    
    	Debug.Clear
    
    	' Create Excel workbook.
    
    	Set Excel = CreateObject("Excel.Application")
    	Excel.Workbooks.Add
    	
    	'Excel.Visible = True
    
    	PrintColumnHeader
    	PrintData
    	
    	MsgBox("Export   Complete!",,"ER/Studio")
    	
    	' make Excel spread sheet visible
    	Excel.Visible = True
    
    
    
    End Sub
    
    Sub PrintData
    	Dim ent As Entity
    	Dim	attr As AttributeObj
    	Dim totalAttr As Integer
    	Dim attrNoDef As Integer
    	Dim entNoDef As Integer
    	Dim totalKeys As Integer
    
    	For Each mdl In diag.Models
    
    		totalAttr = 0
    		attrNoDef = 0
    		entNoDef = 0
    		totalKeys = 0
    
    		PrintCell mdl.Name, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		PrintCell mdl.Entities.Count, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		For Each ent In mdl.Entities
    			'count the number that don't have definitions
    			If ent.Definition = "" Then
    				entNoDef = entNoDef + 1
    			End If
    
    			' count the number of attributes
    			totalAttr = totalAttr + ent.Attributes.Count
    			For Each attr In ent.Attributes
    				' count the number of attributes without defs
    				If attr.Definition = "" Then
    					attrNoDef = attrNoDef + 1
    				End If
    
    				' count the number of key columns
    				'If attr.ForeignKey = True Or attr.PrimaryKey Then
    				'	totalKeys = totalKeys + 1
    				'End If
    			Next
    			' count the number of keys/indexes
    			totalKeys = totalKeys + ent.Indexes.Count
    		Next
    		PrintCell entNoDef, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		PrintCell totalAttr, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		PrintCell attrNoDef, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		PrintCell mdl.Relationships.Count , curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		PrintCell totalKeys, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False
    		curRow = curRow + 1
    		curCol = 1
    	Next
    
    
    
    
    
    End Sub
    
    
    ' Print the column header.  Only print headers when value is true in options array.
    
    Sub PrintColumnHeader
    
    
    		PrintCell "Model Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		PrintCell "# of Entities", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		PrintCell "# Entities without definitions", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		PrintCell "# of Attributes", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		PrintCell "# of Attributes without definitions", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		PrintCell "# of relationships", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		PrintCell "# of Primary, Alternate, & Foreign Keys", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True
    
    		curRow = curRow + 1
    		curCol = 1
    
    End Sub
    
    ' Print a cell
    
    Sub PrintCell(value As Variant, 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