'MACRO TITLE: EXPORT DOMAIN INFO TO EXCEL (Enterprise).BAS 'This macro exports the domains and their properties to excel. 'Each record in the Excel spread sheet represents on domains from the 'data dictionary. The spread sheet can be used to store domains 'outside of ER/Studio. The domain properties can be updated in the 'spread sheet and imported back into an existing model or a new model 'using the "Import Domains From Excel" macro. The columns in the 'spread sheet must remain in the same order to import them properly. ' REQUIREMENT: You must have MS Excel 97 or later installed 'AUTHOR: Jason Tiret 'CONTACT: http://support.embarcadero.com/ 'LAST UPDATE: 5/27/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 dict As Dictionary Dim dom As Domain Dim dom_folder As DomainFolder Dim dictionary_list () As String 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 dict = diag.Dictionary curRow = 1 curCol = 1 Debug.Clear clrBack = CLR_WHITE clrFore = CLR_BLACK clrTitleBack = CLR_GREY clrTitleFore = CLR_BLACK Begin Dialog UserDialog 510,133,"Domain Export" ' %GRID:10,7,1,1 Text 20,21,130,14,"Select Dictionary:",.Text1 DropListBox 150,21,330,112,dictionary_list(),.dictionary_select CancelButton 380,84,90,28 OKButton 270,84,100,28 End Dialog Dim dlg As UserDialog init_dictionary_list If Dialog(dlg) = -1 Then 'choose the proper dictionary If dictionary_list(dlg.dictionary_select) = "Local" Then Set dict = diag.Dictionary Else Set dict = diag.EnterpriseDataDictionaries.Item(dictionary_list(dlg.dictionary_select)) End If Debug.Print dict.Name ' Create Excel workbook. Set Excel = CreateObject("Excel.Application") Excel.Workbooks.Add 'Excel.Visible = True InitColumnWidth PrintColumnHeader PrintData MsgBox("Export Complete!",,"ER/Studio") ' make Excel spread sheet visible Excel.Visible = True End If End Sub 'initialize the dictionary drop down list Sub init_dictionary_list ReDim dictionary_list (0 To diag.EnterpriseDataDictionaries.Count) As String dictionary_list (0) = "Local" i = 1 For Each dict In diag.EnterpriseDataDictionaries dictionary_list (i) = dict.Name i = i + 1 Next End Sub Sub PrintData Dim bHideFont As Boolean bHideFont = False 'loop through the domains and export the properties of the domains For Each dom In dict.Domains PrintCell dom.Name, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.AttributeName, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.ColumnName, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.DomainFolder, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.Definition, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.Note, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.Datatype, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False If dom.DataLength > 0 Then PrintCell dom.DataLength, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False Else PrintCell "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False End If If dom.DataScale > 0 Then PrintCell dom.DataScale, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False Else PrintCell "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False End If If dom.Nullable = True Then PrintCell "YES", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False Else PrintCell "NO", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False End If If dom.Identity = True Then PrintCell "YES", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.IdentitySeed, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell dom.IdentityIncrement, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False Else PrintCell "NO", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False End If curRow = curRow + 1 curCol = 1 Next End Sub ' Initialize the column width. Sub InitColumnWidth Dim count As Integer count = 13 '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 "Domain Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Attribute Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Column Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Domain Folder", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Domain Definition", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Domain Note", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "DataType", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "DataType Width", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "DataType Scale", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Allow Nulls", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Identity Column", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Identity Seed", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Identity Increment", 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