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 + -
显示快捷键?