frmrkquery.frm
来自「通用书店管理系统」· FRM 代码 · 共 1,444 行 · 第 1/5 页
FRM
1,444 行
_StyleDefs(32) = "Splits(0).Columns(0).FooterStyle:id=26,.parent=15"
_StyleDefs(33) = "Splits(0).Columns(0).EditorStyle:id=27,.parent=17"
_StyleDefs(34) = "Splits(0).Columns(1).Style:id=32,.parent=13"
_StyleDefs(35) = "Splits(0).Columns(1).HeadingStyle:id=29,.parent=14"
_StyleDefs(36) = "Splits(0).Columns(1).FooterStyle:id=30,.parent=15"
_StyleDefs(37) = "Splits(0).Columns(1).EditorStyle:id=31,.parent=17"
_StyleDefs(38) = "Named:id=33:Normal"
_StyleDefs(39) = ":id=33,.parent=0"
_StyleDefs(40) = "Named:id=34:Heading"
_StyleDefs(41) = ":id=34,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(42) = ":id=34,.wraptext=-1"
_StyleDefs(43) = "Named:id=35:Footing"
_StyleDefs(44) = ":id=35,.parent=33,.valignment=2,.bgcolor=&H8000000F&,.fgcolor=&H80000012&"
_StyleDefs(45) = "Named:id=36:Selected"
_StyleDefs(46) = ":id=36,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(47) = "Named:id=37:Caption"
_StyleDefs(48) = ":id=37,.parent=34,.alignment=2"
_StyleDefs(49) = "Named:id=38:HighlightRow"
_StyleDefs(50) = ":id=38,.parent=33,.bgcolor=&H8000000D&,.fgcolor=&H8000000E&"
_StyleDefs(51) = "Named:id=39:EvenRow"
_StyleDefs(52) = ":id=39,.parent=33,.bgcolor=&HFFFF00&"
_StyleDefs(53) = "Named:id=40:OddRow"
_StyleDefs(54) = ":id=40,.parent=33"
_StyleDefs(55) = "Named:id=41:RecordSelector"
_StyleDefs(56) = ":id=41,.parent=34"
_StyleDefs(57) = "Named:id=42:FilterBar"
_StyleDefs(58) = ":id=42,.parent=33"
End
End
End
Attribute VB_Name = "frmRKQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strQuery(4) As String
Private strSubQuery(6) As String
Dim a As String
Dim mycn As ADODB.Connection
Dim myrs, myrr As ADODB.Recordset
Dim mysql As String
Public Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub chkFields_Click(Index As Integer)
Select Case Index
Case 0 '供货商
If chkFields(Index).Value = 1 Then
cmdSearch(4).Enabled = True
Else
cmdSearch(4).Enabled = False
End If
Case 1 '库区
If chkFields(Index).Value = 1 Then
cmdSearch(5).Enabled = True
Else
cmdSearch(5).Enabled = False
End If
Case 2 '书号
If chkFields(Index).Value = 1 Then
cmdSearch(6).Enabled = True
Else
cmdSearch(6).Enabled = False
End If
Case 3 '书名
If chkFields(Index).Value = 1 Then
cmdSearch(7).Enabled = True
Else
cmdSearch(7).Enabled = False
End If
' Case 4 '是否审批
' If chkFields(4).Value = 1 Then
' dtpDate(0).Visible = True
' dtpDate(1).Visible = True
' Label1(0).Visible = True
' Label1(1).Visible = True
' Else
' dtpDate(0).Visible = False
' dtpDate(1).Visible = False
' Label1(0).Visible = False
' Label1(1).Visible = False
' End If
' Case 5
' If chkFields(5).Value = 1 Then
' dtpDate(2).Visible = True
' dtpDate(3).Visible = True
' Label1(2).Visible = True
' Label1(3).Visible = True
' Else
' dtpDate(2).Visible = False
' dtpDate(3).Visible = False
' Label1(2).Visible = False
' Label1(3).Visible = False
' End If
Case 6
If chkFields(Index).Value = 1 Then
cmdSearch(9).Enabled = True
Else
cmdSearch(9).Enabled = False
End If
Case 7
If chkFields(Index).Value = 1 Then
cmdSearch(10).Enabled = True
Else
cmdSearch(10).Enabled = False
End If
Case 8
If chkFields(Index).Value = 1 Then
cmdSearch(11).Enabled = True
Else
cmdSearch(11).Enabled = False
End If
Case 9
' If chkFields(9).Value = 1 Then
' dtpDate(4).Visible = True
' dtpDate(5).Visible = True
' Label1(4).Visible = True
' Label1(5).Visible = True
' Else
' dtpDate(4).Visible = False
' dtpDate(5).Visible = False
' Label1(4).Visible = False
' Label1(5).Visible = False
' End If
Case 10
If chkFields(Index).Value = 1 Then
cmdSearch(12).Enabled = True
Else
cmdSearch(12).Enabled = False
End If
Case 11
If chkFields(Index).Value = 1 Then
cmdSearch(13).Enabled = True
Else
cmdSearch(13).Enabled = False
End If
Case 12
' If chkFields(12).Value = 1 Then
' dtpDate(6).Visible = True
' dtpDate(7).Visible = True
' Label1(6).Visible = True
' Label1(7).Visible = True
' Else
' dtpDate(6).Visible = False
' dtpDate(7).Visible = False
' Label1(6).Visible = False
' Label1(7).Visible = False
' End If
Case 13
If chkFields(Index).Value = 1 Then
cmdSearch(14).Enabled = True
Else
cmdSearch(14).Enabled = False
End If
Case 14
If chkFields(Index).Value = 1 Then
cmdSearch(8).Enabled = True
Else
cmdSearch(8).Enabled = False
End If
End Select
End Sub
Private Sub cmdExit_Click(Index As Integer)
Select Case Index
Case 0
Frame1(0).Visible = False
Case 1
Frame1(1).Visible = False
Case 2
Frame1(2).Visible = False
Case 3
Frame1(3).Visible = False
End Select
End Sub
Private Sub cmdOK_Click(Index As Integer)
Dim i As Integer
Dim strFoot As String
Dim sqlstring As String
Dim rs As New ADODB.Recordset
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset
For i = 0 To 5
strSubQuery(i) = ""
Next i
Select Case Index
Case 0
'供货商
If chkFields(0).Value = 1 And Trim(txtFields(0).Text) <> "" Then
strSubQuery(0) = "chrClientNO = '" & Trim(a) & "'"
End If
'库区
If chkFields(1).Value = 1 And Trim(txtFields(1).Text) <> "" Then
strSubQuery(1) = "chrStorageNO like'%" & Trim(txtFields(1).Text) & "%'"
End If
'书号
If chkFields(2).Value = 1 And Trim(txtFields(2).Text) <> "" Then
strSubQuery(2) = "t4.chrBookNO like '%" & Trim(txtFields(2).Text) & "%'"
End If
'书名
If chkFields(3).Value = 1 And Trim(txtFields(3).Text) <> "" Then
strSubQuery(3) = "t4.chrBookName like '%" & Trim(txtFields(3).Text) & "%'"
End If
'入库单号
If chkFields(14).Value = 1 And Trim(txtFields(10).Text) <> "" Then
strSubQuery(4) = "t4.chrRKDH like '%" & Trim(txtFields(10).Text) & "%'"
End If
'是否已审批
If chkFields(4).Value = 1 Then
Select Case cmbFields(0)
Case "是"
strSubQuery(5) = "t4.DatCheckDate between #" & Format(dtpDate(0).Value, "yyyy-mm-dd") & _
"# and #" & Format(dtpDate(1).Value, "yyyy-mm-dd") & "#"
Case "否"
strSubQuery(5) = "t4.DatCheckDate is null"
End Select
End If
strQuery(0) = "where "
For i = 0 To 5
If Trim(strSubQuery(i)) <> "" Then
strQuery(0) = strQuery(0) & strSubQuery(i) & " and "
End If
Next
If Trim(strQuery(0)) = "where" Then
strQuery(0) = strQuery(0) & " 2=2 and "
End If
strQuery(0) = Mid(strQuery(0), 1, Len(strQuery(0)) - 4)
If Trim(strQuery(0)) = "where" Then '没选任何条件
Frame1(0).Visible = False
Exit Sub
Else
sqlstring = "SELECT top 1 chrRKDH,t1.chrBookNo,t1.chrBookName,t3.ChrClientName, t2.ChrStorageName,t1.decPrice,decSubAgio,IntLDS," & _
"IntSSS, decFactPrice1,decMoney1, decFactPrice2,decMoney2,t1.DatCheckDate FROM ([SELECT distinct t4.chrRKDH,t4.chrBookNo,t4.chrBookName," & _
"t4.chrClientNo,t4.chrStorageNo,t4.decPrice,t4.decSubAgio,t5.IntLDS,t5.IntSSS,t4.DecPrice*t5.intLDS as decFactPrice1,t4.DecPrice*t5.intSSS " & _
"as decFactPrice2,t4.decSubAgio*t4.decPrice*t5.intLDS as decMoney1,t4.decSubAgio*t4.decPrice*t5.intSSS as decMoney2,t4.DatCheckDate from V_InstorageInformation t4 " & _
"LEFT JOIN InstorageInformation_List t5 ON (t4.chrBookNo=t5.chrBookNo) and (t4.chrBookName=t5.chrBookName) and (t4.chrRKDH=t5.chrRKDH) " & strQuery(0) & "]. AS t1 LEFT JOIN StorageSection AS t2 ON t1.chrStorageNo = t2.ChrStorageNo) LEFT JOIN " & _
"ClientData T3 ON (t1.chrClientNo = T3.ChrClientNo) order by t1.chrRKDH desc"
Set rstmp = New ADODB.Recordset
rstmp.Open sqlstring, cN, adOpenKeyset, adLockPessimistic
Set tdbQuery(0).DataSource = rstmp
'单书明细
sqlstring = "SELECT chrRKDH,t1.chrBookNo,t1.chrBookName,t3.ChrClientName, t2.ChrStorageName,t1.decPrice,decSubAgio,IntLDS," & _
"IntSSS, decFactPrice1, decMoney1,decFactPrice2,decMoney2,t1.DatCheckDate FROM ([SELECT distinct t4.chrRKDH,t4.chrBookNo,t4.chrBookName," & _
"t4.chrClientNo,t4.chrStorageNo,t4.decPrice,t4.decSubAgio,t5.IntLDS,t5.IntSSS,t4.DecPrice*t5.intLDS as decFactPrice1,t4.DecPrice*t5.intSSS " & _
"as decFactPrice2,t4.decSubAgio*t4.decPrice*t5.intLDS as decMoney1,t4.decSubAgio*t4.decPrice*t5.intSSS as decMoney2,t4.DatCheckDate from V_InstorageInformation t4 " & _
"LEFT JOIN InstorageInformation_List t5 ON (t4.chrBookNo=t5.chrBookNo) and (t4.chrBookName=t5.chrBookName) and (t4.chrRKDH=t5.chrRKDH) " & strQuery(0) & "]. AS t1 LEFT JOIN StorageSection AS t2 ON t1.chrStorageNo = t2.ChrStorageNo) LEFT JOIN " & _
"ClientData T3 ON (t1.chrClientNo = T3.ChrClientNo) order by t1.chrRKDH desc"
Set rstmp = New ADODB.Recordset
rs.Open sqlstring, cN, adOpenKeyset, adLockPessimistic
Set tdbQuery(0).DataSource = rs
sqlstring = "SELECT sum(intLDS) ,sum(intSSS),sum(decFactPrice1),sum(decMoney1),sum(decFactPrice2),sum(decMoney2) FROM (SELECT distinct t4.chrRKDH," & _
"t4.chrBookNo,t4.chrBookName,t4.chrClientNo,t4.chrStorageNo,t4.decPrice,t4.decSubAgio,t5.IntLDS,t5.IntSSS,t4.DecPrice*t5.intLDS as decFactPrice1," & _
"t4.DecPrice*t5.intSSS as decFactPrice2,t4.decSubAgio*t4.decPrice*t5.intLDS as decMoney1,t4.decSubAgio*t4.decPrice*t5.intSSS as decMoney2,t4.DatCheckDate from V_InstorageInformation t4 " & _
"LEFT JOIN InstorageInformation_List t5 ON (t4.chrBookNo=t5.chrBookNo) and (t4.chrBookName=t5.chrBookName) and (t4.chrRKDH=t5.chrRKDH) " & strQuery(0) & ") T1"
Set rsNewTmp = New ADODB.Recordset
rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
If Not rsNewTmp.EOF Then
strFoot = "|||||||" & Format(rsNewTmp.Fields(0), "#,##0") & "| " & Format(rsNewTmp.Fields(1), "#,##0.00") & "| " & Format(rsNewTmp.Fields(2), "#,##0.00") & _
"|" & Format(rsNewTmp.Fields(3), "#,##0.00") & "|" & Format(rsNewTmp.Fields(4), "#,##0.00") & "|" & Format(rsNewTmp.Fields(5), "#,##0.00") & "|||||"
Else
strFoot = "||||||||||||||"
End If
Call SetGridheader("入库单|书号|书名|供货商|库区|单价|折扣|来单数|实收数|来单码
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?