VBA/pricelist.frm

197 lines
4.2 KiB
Plaintext
Raw Normal View History

2020-01-10 14:17:29 -05:00
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} pricelist
Caption = "Price List Name"
ClientHeight = 7995
2020-01-10 14:17:29 -05:00
ClientLeft = 120
ClientTop = 465
ClientWidth = 11865
2020-01-10 14:17:29 -05:00
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
2021-08-13 11:01:28 -04:00
2020-01-10 14:17:29 -05:00
Public proceed As Boolean
Private pl() As String
Private plv() As Variant
Private plfv() As Variant
2020-01-10 14:17:29 -05:00
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
2020-01-10 14:17:29 -05:00
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
2020-01-10 14:17:29 -05:00
Private Sub UserForm_Initialize()
2020-01-10 14:17:29 -05:00
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
2021-08-13 11:01:28 -04:00
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))
2021-08-13 11:01:28 -04:00
cbLIST.list = plv
lbLIST.list = plfv
'lbHEAD.ColumnCount = lbHist.ColumnCount
'lbHEAD.ColumnWidths = lbHist.ColumnWidths
Call FL.x.frmListBoxHeader(lbHEAD, lbLIST, "plcode", "descr1", "descr2", "descr3")
2020-01-10 14:17:29 -05:00
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
2021-08-13 11:01:28 -04:00
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
2020-01-10 14:17:29 -05:00