VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist Caption = "Price List Name" ClientHeight = 7995 ClientLeft = 120 ClientTop = 465 ClientWidth = 11865 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 cbInactive_Click() 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(1, 1) Me.tbD2 = plc(2, 1) Me.tbD3 = plc(3, 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, "PTROWBRIDG", "QQQX53@041") Then ' MsgBox (FL.x.ADOo_errstring) ' Exit Sub ' End If ' End If If Not FL.x.ADOp_OpenCon(1, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@046") Then MsgBox (FL.x.ADOo_errstring) Exit Sub End If pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1,d2,d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True) Call FL.x.ADOp_CloseCon(1) 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", "descr1", "descr2", "descr3") End Sub Private Sub UserForm_Terminate() proceed = False End Sub Sub load_lists() 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, "PTROWBRIDG", "QQQX53@041") Then ' MsgBox (FL.x.ADOo_errstring) ' Exit Sub ' End If ' End If If Not FL.x.ADOp_OpenCon(1, ISeries, "S7830956", False, "PTROWBRIDG", "QQQX53@046") Then MsgBox (FL.x.ADOo_errstring) Exit Sub End If pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1, d2, d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True) Call FL.x.ADOp_CloseCon(1) 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", "d1", "d2", "d3") End Sub