VBA/pricelist.frm

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


Option Explicit

Public proceed As Boolean
Private pl() As String
Private plv() As Variant
Private plfv() As Variant
Public tbo As New TheBigOne



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()

    Dim fd As Object

    '--------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 tbo.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
    
    login.Caption = "CMS Login"
    login.tbU = UCase(Mid(Mid(Application.UserLibraryPath, 10, InStr(10, Application.UserLibraryPath, "\") - 10), 1, 10))
    login.tbP = ""
    login.Show
    If Not login.proceed Then Exit Sub

    If Not tbo.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU.text, login.tbP.text) Then
        MsgBox (tbo.ADOo_errstring)
        Exit Sub
    End If
    
    pl = tbo.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False)
    'pl = FL.x.ADOp_SelectS(1, "SELECT plcode, d1,d2,d3 FROM RLARP.PLM p ORDER BY plcode", True, 1000, True)
    Call tbo.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 = tbo.TBLp_StringToVar(tbo.TBLp_Transpose(pl))
    
    
    
    cbLIST.list = plv
    lbLIST.list = plfv
    
    'lbHEAD.ColumnCount = lbHist.ColumnCount
    'lbHEAD.ColumnWidths = lbHist.ColumnWidths
    
    Call tbo.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
    
    login.Caption = "CMS Login"
    login.tbU = Mid(UCase(Mid(Application.UserLibraryPath, 10, InStr(10, Application.UserLibraryPath, "\") - 10)), 1, 10)
    login.tbP = ""
    login.Show
    If Not login.proceed Then Exit Sub
    
    
    If Not tbo.ADOp_OpenCon(1, ISeries, "S7830956", False, login.tbU.text, login.tbP.text) Then
        MsgBox (tbo.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)
    pl = tbo.ADOp_SelectS(1, "SELECT JAPLCD, JAPLDS, JAPLD1, JAPLD2 FROM lgdat.iprca WHERE TRIM(COALESCE(JAPLCD,'')) <> '' ORDER BY JAPLCD ASC", True, 1000, False)
    Call tbo.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 = tbo.TBLp_StringToVar(tbo.TBLp_Transpose(pl))
    
    cbLIST.list = plv
    lbLIST.list = plfv
    
    'lbHEAD.ColumnCount = lbHist.ColumnCount
    'lbHEAD.ColumnWidths = lbHist.ColumnWidths
    
    Call tbo.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "d1", "d2", "d3")
End Sub