'MACRO TITLE: EXPORT REFERENCE VALUE INFO TO EXCEL (Enterprise).BAS 'This macro exports the reference values and their properties to excel. 'Each record in the Excel spread sheet represents one ref val from the 'data dictionary. The spread sheet can be used to store reference values 'outside of ER/Studio. The properties can be updated in the 'spread sheet and imported back into an existing model or a new model 'using the "Import Reference Values 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/8/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 refval As ReferenceValue Dim Value As ValuePair 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,"Reference Value 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 ' 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 refval In dict.ReferenceValues If refval.IsRange = True Then PrintCell refval.Name, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell refval.Description, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell "Range",curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell refval.IsNotBetween, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell refval.MinValue, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell refval.MaxValue, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False curRow = curRow + 1 curCol = 1 Else For Each Value In refval.Values PrintCell refval.Name, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell refval.Description, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell "List",curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell refval.IsNotBetween, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell Value.Value, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell "", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False PrintCell Value.ValueDescription, curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, False curRow = curRow + 1 curCol = 1 Next End If 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 "Reference Value Name", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Reference Value Description", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Reference Value Type", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "Value NOT Between", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "RV Value", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "RV End Value", curRow, curCol, 0, 1, clrTitleFore, clrTitleBack, 10, True PrintCell "RV Value Description", 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