VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist Caption = "Price List Name" ClientHeight = 7680 ClientLeft = 120 ClientTop = 465 ClientWidth = 8895.001 OleObjectBlob = "pricelist.frx":0000 StartUpPosition = 1 'CenterOwner End Attribute VB_Name = "pricelist" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public proceed As Boolean Private pl() As String Private plv() As Variant Private plfv() As Variant Private Sub bCANCEL_Click() proceed = False Me.Hide End Sub Private Sub bOK_Click() If tbPATH = "" Then MsgBox ("no directory specified") Exit Sub End If proceed = True Me.Hide End Sub Private Sub bPICK_Click() '--------Open file------------- Set fd = Application.FileDialog(msoFileDialogFolderPicker) fd.Show tbPATH.Text = fd.SelectedItems(1) End Sub Private Sub cbLIST_Change() Dim plc() As String plc = pl Call FL.x.TBLp_FilterSingle(plc, 0, cbLIST.value, True) If UBound(plc, 2) = 0 Then Exit Sub Me.tbD1 = plc(5, 1) 'Me.tbD2 = plc(12, 1) 'Me.tbD3 = plc(13, 1) End Sub Private Sub lbLIST_Click() Dim i As Long For i = 1 To lbLIST.ListCount If lbLIST.Selected(i) Then cbLIST.value = lbLIST.list(i, 0) Exit Sub End If Next i Me.cbHDR.value = "3 - Update" End Sub Private Sub UserForm_Initialize() proceed = False Dim x() As Variant Dim i As Long ReDim x(3) x(1) = "1 - New" x(2) = "2 - Replace" x(3) = "3 - Update" Dim dtl() As Variant ReDim dtl(3) dtl(1) = "1 - Add" dtl(2) = "2 - Update" dtl(3) = "3 - Delete" cbHDR.list = x cbDTL.list = dtl If login.tbP = "" Then login.Show If Not login.proceed Then Exit Sub If Not FL.x.ADOp_OpenCon(0, ISeries, "S7830956", False, login.tbU, login.tbP) Then MsgBox (FL.x.ADOo_errstring) Exit Sub End If End If pl = FL.x.ADOp_SelectS(0, "SELECT plcode, func, basis, tier, currency, d1 FROM RLARP.PLM p ORDER BY func, tier", True, 1000, True) Call FL.x.ADOp_CloseCon(0) ReDim plv(1 To UBound(pl, 2)) For i = 1 To UBound(pl, 2) plv(i) = pl(0, i) Next i plfv = FL.x.TBLp_StringToVar(FL.x.TBLp_Transpose(pl)) cbLIST.list = plv lbLIST.list = plfv 'lbHEAD.ColumnCount = lbHist.ColumnCount 'lbHEAD.ColumnWidths = lbHist.ColumnWidths Call FL.x.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "func", "basis", "tier", "currency", "d1") End Sub Private Sub UserForm_Terminate() proceed = False End Sub