'TITLE: IMPORT REFERENCE VALUES FROM EXCEL (Enterprise) 'DESCRIPTION: This macro is used to import reference values from ' Microsoft Excel. A sample spreadsheet can be printed when ' executing the macro. Read the below ReadMe for the valid values ' of each column in the spreadsheet. 'AUTHOR: Jason Tiret 'CONTACT: http://support.embarcadero.com/ 'LAST MODIFY DATE: 5/27/2003 'README: This defines datatypes and constraints on each column of ' the speadsheet. The first row of the spread sheet is reserved for ' column headers. Values in the first row will be ignored. ' The specified column order is required for proper import. All ' columns are required in the spreadsheet, but some may have null ' values. The spread sheet can be used to update existing ' reference values or import new values. For list reference ' values, the new values are appended to the list. For range ' reference values, the information will be updated from the spread ' sheet. Blank rows will be ignored. 'FORMAT OF SPREAD SHEET: '(Column Order Number) Column Name - Datatype - Description ' (1) Reference Value Name - String - This is required in the spread ' sheet. The case is not sensitive meaning the case doesn't ' have to match in the spread sheet or between the spread ' sheet and existing reference values in the data dictionary. ' This name will be duplicated for list values with each list ' value and value description different for each. The other ' columns will be ingored. ' (2) Reference Value Description - String - This is the description ' for the reference value. This can be null. For list values ' it only has to be in the first entry. ' (3) Reference Value Type - String - The valid values are "LIST" or ' "RANGE". This is required. ' (4) Values NOT Between - String - The valid values are "True" or ' "False". False is the default if left blank. ' (5) RV Value - Alphanumeric - This is the minvalue (or start value) ' for range reference values. This is a list value for a ' List reference value. This is required. ' (6) RV End Value - Alphanumeric - This is the max (or end value) ' for range reference values. This is null for list reference ' values. ' (7) RV Description - String - This is the value description for ' list reference values. This is null for range reference ' values. Dim diag As Diagram Dim dict As Dictionary Dim dictionary_list () As String Sub Main Dim refval As ReferenceValue Dim excel As Object Debug.Clear Set diag = DiagramManager.ActiveDiagram 'Set dict = diag.Dictionary Debug.Clear 'Debug.Print diag.ActiveModel.Name Begin Dialog UserDialog 550,266,"Import Reference Values From Excel",.DialogFunc ' %GRID:10,7,1,1 DropListBox 170,14,340,112,dictionary_list(),.dictionary_select Text 30,56,170,14,"Path to XLS spreadsheet:",.Text1 TextBox 70,84,340,21,.path OKButton 270,231,110,21 CancelButton 410,231,110,21 PushButton 430,84,60,21,"Browse",.Browse Text 70,182,400,35,"Note: Reference Values must be in Sheet 1. See ReadMe for the format of the sheet. Double-click on macro to view ReadMe.",.Text2 PushButton 60,133,150,28,"Get Sample Sheet",.SampleSheet Text 30,21,120,14,"Select Dictionary:",.Text3 End Dialog Dim dlg As UserDialog init_dictionary_list start_dialog: 'start dialog If Dialog(dlg) = -1 Then 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 'initialize excel object and make visible Set excel = CreateObject("Excel.Application") 'excel.Visible = True 'this Error Is For an errant file path, Dialog will be restarted On Error GoTo Error_handle excel.workbooks.open dlg.path ImportRVs(excel) excel.workbooks.Close 'excel.visible = False Exit Sub Error_handle: MsgBox("Please enter a valid path.",,"Error!") GoTo start_dialog 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 Function ImportRVs(ex As Variant) Dim sheet As Object Dim range As Object Dim RVCount As Integer Dim refval As ReferenceValue Dim currentRV As String Dim lastRV As String Dim RVvalue As ValuePair Set sheet = ex.worksheets(1) Set range = sheet.usedrange range.select 'On Error GoTo message RVCount = range.rows.Count Debug.Print "Reference Value Count = " & RVCount If RVCount >= 2 Then For i = 2 To RVCount If range.cells(i,1).Value <> "" Then If UCase(range.cells(i,3).Value) = "RANGE" Then If dict.ReferenceValues.Item(range.cells(i,1).Value) Is Nothing Then Set refval = dict.ReferenceValues.Add(range.cells(i,1).Value) Else Set refval = dict.ReferenceValues.Item(range.cells(i,1).Value) End If refval.IsRange = True refval.Description = range.cells(i,2).Value refval.MinValue = CStr(range.cells(i,5).Value) refval.MaxValue = CStr(range.cells(i,6).Value) If UCase(range.cells(i,4).Value) = "TRUE" Then refval.IsNotBetween = True Else refval.IsNotBetween = False End If ElseIf UCase(range.cells(i,3).Value) = "LIST" Then currentRV = range.cells(i,1).Value If dict.ReferenceValues.Item(currentRV) Is Nothing Then 'create a new Reference value since it doesn't exist Set refval = dict.ReferenceValues.Add(currentRV) Else 'just add the new value and description to existing RV Set refval = dict.ReferenceValues.Item(currentRV) End If refval.IsRange = False refval.IsRange = False refval.Description = range.cells(i,2).Value Set RVvalue = refval.Values.Item(CStr(range.cells(i,5).Value)) If refval.Values.Item(CStr(range.cells(i,5).Value)) Is Nothing Then refval.Values.Add(CStr(range.cells(i,5).Value), CStr(range.cells(i,7).Value)) Else RVvalue.Value = CStr(range.cells(i,5).Value) RVvalue.ValueDescription = CStr(range.cells(i,7).Value) End If If UCase(range.cells(i,4).Value) = "TRUE" Then refval.IsNotBetween = True Else refval.IsNotBetween = False End If End If End If Next End If 'message: ' MsgBox("There is no ""Domains"" sheet in the workbook or the name is invalid. Domains will not be imported.") ' Exit Function End Function Sub PrintSampleSheet() Dim ex As Object Dim wb, ws As Variant Set ex = CreateObject("excel.application") ex.visible = True Set wb = ex.workbooks.Add Set ws = wb.activesheet ws.cells(1,1).Value = "Reference Value Name" ws.cells(1,2).Value = "Reference Value Description" ws.cells(1,3).Value = "Reference Value Type" ws.cells(1,4).Value = "Values NOT Between" ws.cells(1,5).Value = "RV Value" ws.cells(1,6).Value = "RV End Value" ws.cells(1,7).Value = "RV Value Description" ws.cells(2,1).Value = "string - required" ws.cells(2,2).Value = "string - optional" ws.cells(2,3).Value = """Range"" or ""List"" - required" ws.cells(2,4).Value = """True"" or ""False"" - optional (false is default)" ws.cells(2,5).Value = "alphanumeric (Begin value for Range RVs) - required" ws.cells(2,6).Value = "alphanumeric (null for ""List"" type) - required for Range type" ws.cells(2,7).Value = "string (Null for Range RVs) - optional" ws.cells(3,1).Value = "***Remove rows 2-4 from the spread sheet to import back into ER/Studio***" ws.cells(5,1).Value = "Product Codes" ws.cells(5,2).Value = "These are the product codes for the product value look up table" ws.cells(5,3).Value = "List" ws.cells(5,4).Value = "False" ws.cells(5,5).Value = "1" ws.cells(5,6).Value = "" ws.cells(5,7).Value = "" ws.cells(6,1).Value = "Product Codes" ws.cells(6,2).Value = "" ws.cells(6,3).Value = "List" ws.cells(6,4).Value = "False" ws.cells(6,5).Value = "2" ws.cells(6,6).Value = "" ws.cells(6,7).Value = "" ws.cells(7,1).Value = "Product Codes" ws.cells(7,2).Value = "" ws.cells(7,3).Value = "List" ws.cells(7,4).Value = "False" ws.cells(7,5).Value = "3" ws.cells(7,6).Value = "" ws.cells(7,7).Value = "" ws.cells(8,1).Value = "Product Codes" ws.cells(8,2).Value = "" ws.cells(8,3).Value = "List" ws.cells(8,4).Value = "False" ws.cells(8,5).Value = "4" ws.cells(8,6).Value = "" ws.cells(8,7).Value = "" ws.cells(9,1).Value = "Region Codes" ws.cells(9,2).Value = "These are the valid region values" ws.cells(9,3).Value = "List" ws.cells(9,4).Value = "" ws.cells(9,5).Value = "1" ws.cells(9,6).Value = "" ws.cells(9,7).Value = "" ws.cells(10,1).Value = "Region Codes" ws.cells(10,2).Value = "" ws.cells(10,3).Value = "List" ws.cells(10,4).Value = "" ws.cells(10,5).Value = "2" ws.cells(10,6).Value = "" ws.cells(10,7).Value = "" ws.cells(11,1).Value = "Region Codes" ws.cells(11,2).Value = "" ws.cells(11,3).Value = "List" ws.cells(11,4).Value = "" ws.cells(11,5).Value = "3" ws.cells(11,6).Value = "" ws.cells(11,7).Value = "" ws.cells(12,1).Value = "Region Codes" ws.cells(12,2).Value = "" ws.cells(12,3).Value = "List" ws.cells(12,4).Value = "" ws.cells(12,5).Value = "4" ws.cells(12,6).Value = "" ws.cells(12,7).Value = "" ws.cells(13,1).Value = "Salary" ws.cells(13,2).Value = "This is the typical salary range for each employee" ws.cells(13,3).Value = "Range" ws.cells(13,4).Value = "False" ws.cells(13,5).Value = "-10000" ws.cells(13,6).Value = "100000" ws.cells(13,7).Value = "" ws.cells(14,1).Value = "Commission" ws.cells(14,2).Value = "This is the commission range" ws.cells(14,3).Value = "Range" ws.cells(14,4).Value = "False" ws.cells(14,5).Value = "20000" ws.cells(14,6).Value = "50000" ws.cells(14,7).Value = "" ws.cells(15,1).Value = "Bank Type" ws.cells(15,2).Value = "This determines each bank type" ws.cells(15,3).Value = "List" ws.cells(15,4).Value = "False" ws.cells(15,5).Value = "1" ws.cells(15,6).Value = "" ws.cells(15,7).Value = "" ws.cells(16,1).Value = "Bank Type" ws.cells(16,2).Value = "" ws.cells(16,3).Value = "List" ws.cells(16,4).Value = "" ws.cells(16,5).Value = "2" ws.cells(16,6).Value = "" ws.cells(16,7).Value = "" ws.cells(17,1).Value = "STATE" ws.cells(17,2).Value = "State codes" ws.cells(17,3).Value = "List" ws.cells(17,4).Value = "False" ws.cells(17,5).Value = "CA" ws.cells(17,6).Value = "" ws.cells(17,7).Value = "" ws.cells(18,1).Value = "STATE" ws.cells(18,2).Value = "State codes" ws.cells(18,3).Value = "List" ws.cells(18,4).Value = "False" ws.cells(18,5).Value = "NY" ws.cells(18,6).Value = "" ws.cells(18,7).Value = "" ws.cells(19,1).Value = "STATE" ws.cells(19,2).Value = "State codes" ws.cells(19,3).Value = "List" ws.cells(19,4).Value = "False" ws.cells(19,5).Value = "OH" ws.cells(19,6).Value = "" ws.cells(19,7).Value = "" ws.cells(20,1).Value = "STATE" ws.cells(20,2).Value = "State codes" ws.cells(20,3).Value = "List" ws.cells(20,4).Value = "False" ws.cells(20,5).Value = "MA" ws.cells(20,6).Value = "" ws.cells(20,7).Value = "" ws.cells(21,1).Value = "State" ws.cells(21,2).Value = "State codes" ws.cells(21,3).Value = "List" ws.cells(21,4).Value = "False" ws.cells(21,5).Value = "AZ" ws.cells(21,6).Value = "" ws.cells(21,7).Value = "" ws.cells(22,1).Value = "STATE" ws.cells(22,2).Value = "State codes" ws.cells(22,3).Value = "List" ws.cells(22,4).Value = "False" ws.cells(22,5).Value = "NV" ws.cells(22,6).Value = "" ws.cells(22,7).Value = "" ws.cells(23,1).Value = "STATE" ws.cells(23,2).Value = "" ws.cells(23,3).Value = "List" ws.cells(23,4).Value = "False" ws.cells(23,5).Value = "HI" ws.cells(23,6).Value = "" ws.cells(23,7).Value = "" ws.cells(24,1).Value = "STATE" ws.cells(24,2).Value = "" ws.cells(24,3).Value = "List" ws.cells(24,4).Value = "False" ws.cells(24,5).Value = "ID" ws.cells(24,6).Value = "" ws.cells(24,7).Value = "" ws.cells(25,1).Value = "STATE" ws.cells(25,2).Value = "" ws.cells(25,3).Value = "List" ws.cells(25,4).Value = "False" ws.cells(25,5).Value = "MO" ws.cells(25,6).Value = "" ws.cells(25,7).Value = "" ws.cells(26,1).Value = "stATE" ws.cells(26,2).Value = "" ws.cells(26,3).Value = "List" ws.cells(26,4).Value = "False" ws.cells(26,5).Value = "MI" ws.cells(26,6).Value = "" ws.cells(26,7).Value = "" ws.cells(27,1).Value = "STATE" ws.cells(27,2).Value = "" ws.cells(27,3).Value = "List" ws.cells(27,4).Value = "False" ws.cells(27,5).Value = "MD" ws.cells(27,6).Value = "" ws.cells(27,7).Value = "" ws.cells(28,1).Value = "STATE" ws.cells(28,2).Value = "" ws.cells(28,3).Value = "List" ws.cells(28,4).Value = "False" ws.cells(28,5).Value = "OR" ws.cells(28,6).Value = "" ws.cells(28,7).Value = "" ws.cells(29,1).Value = "STATE" ws.cells(29,2).Value = "" ws.cells(29,3).Value = "List" ws.cells(29,4).Value = "False" ws.cells(29,5).Value = "MN" ws.cells(29,6).Value = "" ws.cells(29,7).Value = "" ws.cells(30,1).Value = "STATE" ws.cells(30,2).Value = "" ws.cells(30,3).Value = "List" ws.cells(30,4).Value = "False" ws.cells(30,5).Value = "WY" ws.cells(30,6).Value = "" ws.cells(30,7).Value = "" ws.cells(31,1).Value = "STATE" ws.cells(31,2).Value = "" ws.cells(31,3).Value = "List" ws.cells(31,4).Value = "False" ws.cells(31,5).Value = "TX" ws.cells(31,6).Value = "" ws.cells(31,7).Value = "" ws.cells(32,1).Value = "STATE" ws.cells(32,2).Value = "" ws.cells(32,3).Value = "List" ws.cells(32,4).Value = "False" ws.cells(32,5).Value = "OK" ws.cells(32,6).Value = "" ws.cells(32,7).Value = "" ws.cells(33,1).Value = "STATE" ws.cells(33,2).Value = "" ws.cells(33,3).Value = "List" ws.cells(33,4).Value = "False" ws.cells(33,5).Value = "VM" ws.cells(33,6).Value = "" ws.cells(33,7).Value = "" ws.cells(34,1).Value = "STATE" ws.cells(34,2).Value = "" ws.cells(34,3).Value = "List" ws.cells(34,4).Value = "False" ws.cells(34,5).Value = "PA" ws.cells(34,6).Value = "" ws.cells(34,7).Value = "" ws.cells(35,1).Value = "STATE" ws.cells(35,2).Value = "" ws.cells(35,3).Value = "List" ws.cells(35,4).Value = "False" ws.cells(35,5).Value = "FL" ws.cells(35,6).Value = "" ws.cells(35,7).Value = "" ws.cells(36,1).Value = "STATE" ws.cells(36,2).Value = "" ws.cells(36,3).Value = "List" ws.cells(36,4).Value = "False" ws.cells(36,5).Value = "NM" ws.cells(36,6).Value = "" ws.cells(36,7).Value = "" ws.cells(37,1).Value = "STATE" ws.cells(37,2).Value = "" ws.cells(37,3).Value = "List" ws.cells(37,4).Value = "False" ws.cells(37,5).Value = "WI" ws.cells(37,6).Value = "" ws.cells(37,7).Value = "" ws.cells(38,1).Value = "STATE" ws.cells(38,2).Value = "" ws.cells(38,3).Value = "List" ws.cells(38,4).Value = "False" ws.cells(38,5).Value = "IW" ws.cells(38,6).Value = "" ws.cells(38,7).Value = "" With ws.range(ws.cells(1,1),ws.cells(1,7)) .font.Size = 12 .font.Bold = True .columnwidth = 30 End With End Sub
Rem See DialogFunc help topic for more information. Private Function DialogFunc(DlgItem$, Action%, SuppValue&) As Boolean Select Case Action% Case 1 ' Dialog box initialization Case 2 ' Value changing or button pressed If DlgItem = "Browse" Then 'browse to excel file if used pushes browse button. Put path in text box. DlgText "path", GetFilePath(,"xls",,"Open SpreadSheet") DialogFunc = True ElseIf DlgItem = "SampleSheet" Then PrintSampleSheet DialogFunc = True ElseIf DlgItem = "OK" And DlgText("path") = "" Then 'don't exit dialog if a path is not specified MsgBox("Please enter a valid path.",,"Error!") DialogFunc = True End If Rem DialogFunc = True ' Prevent button press from closing the dialog box Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 ' Idle Rem DialogFunc = True ' Continue getting idle actions Case 6 ' Function key End Select End Function