frmckauditing.frm

来自「通用书店管理系统」· FRM 代码 · 共 784 行 · 第 1/3 页

  
  Set grdQryResult(1).DataSource = rstmp
  
  Call SetGridheader("出库单号|出库类型|出库库区|入库库区|折扣|经办人|总数量|总码洋|总实洋|备注|制单人|制单日期", 1)

  
  sqlstring = "select top 1 chrCKDH,chrBookNo,chrBookName,decPrice,decAgio,chrCB,intBagCount,intOddment,intAmount,intStorageAmount from v_OutstorageInformation_List where chrCKDH='00'"
  Set rsNewTmp = New ADODB.Recordset
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
  Set grdQryResult(0).DataSource = rsNewTmp
  
  Call SetGridheader("出库单号|书号|书名|单价|折扣|册/包|包数|零头|出库数量|库存数", 0)

  
  
  Exit Sub
Err:
  cN.RollbackTrans
  MsgBox "审批出库单失败：" & Err.Description, vbInformation
End Sub

Private Sub chkFields_Click(Index As Integer)
  If chkFields(0).Value = 0 Then
     txtFields(0).Enabled = False
     cmdSearch(0).Enabled = False
  Else
     txtFields(0).Enabled = True
     cmdSearch(0).Enabled = True
  End If
  
  If chkFields(1).Value = 0 Then
     dtpInDate(0).Enabled = False
     dtpInDate(1).Enabled = False
  Else
     dtpInDate(0).Enabled = True
     dtpInDate(1).Enabled = True
  End If
End Sub

Public Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub cmdOK_Click()
  On Error GoTo Err
  Dim itemX As ListItem
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim rsNewTmp As New ADODB.Recordset
    
  If chkFields(0).Value = 1 And chkFields(1).Value = 1 Then
     If txtFields(0).Text = "" Then
        MsgBox "请输入出库单号", vbInformation
        Exit Sub
     End If
     
     sqlstring = "select * from OutstorageInformation where DatSPDate is null and chrCKDH like '%" & _
                 txtFields(0).Text & "%' and datDate between #" & dtpInDate(0).Value & "# and #" & dtpInDate(1).Value & "# order by chrCKDH"
     rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
     
  ElseIf chkFields(0).Value = 1 Then '按出库单号查询
     If txtFields(0).Text = "" Then
        MsgBox "请输入出库单号", vbInformation
        Exit Sub
     End If
     
     sqlstring = "select * from OutstorageInformation where DatSPDate is null and chrCKDH like '%" & _
                 txtFields(0).Text & "%' order by chrCKDH"
     rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
     
  ElseIf chkFields(1).Value = 1 Then '按出库单填制日期查询
     sqlstring = "select * from OutstorageInformation where DatSPDate is null and datDate between #" & _
                 dtpInDate(0).Value & "# and #" & dtpInDate(1).Value & "# order by chrCKDH"
     rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Else
     Exit Sub
  End If
  
   '设置视图的显示方式
   lstFields.ListItems.Clear
   lstFields.Checkboxes = True
   '添加视图内容
 
   lstFields.ListItems.Clear
   
   Do While Not rstmp.EOF
     Set itemX = lstFields.ListItems.Add(, , rstmp.Fields("chrCKDH"))
     rstmp.MoveNext
   Loop
   
   strWhereCondition = ""
   
   
   sqlstring = "select top 1 chrCKDH,t2.ChrOutStorageName,t3.ChrStorageName,t4.ChrStorageName,t1.decAgio,ChrJBR,intTotal,decMY,decSY,chrRemark,ChrZDR,datDate" & _
              " FROM ((OutstorageInformation t1 left JOIN OutStorageType t2 ON " & _
              "t1.ChrOutStorageNo = t2.ChrOutStorageNo) left JOIN StorageSection t3 ON t1.ChrStorageNo1 = t3.ChrStorageNo) " & _
              "left JOIN StorageSection t4 ON t1.ChrStorageNo2 = t4.ChrStorageNo where chrCKDH='00'"
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
  Set grdQryResult(1).DataSource = rstmp
  
  Call SetGridheader("出库单号|出库类型|出库库区|入库库区|折扣|经办人|总数量|总码洋|总实洋|备注|制单人|制单日期", 1)

  
  sqlstring = "select top 1 chrCKDH,chrBookNo,chrBookName,decPrice,decAgio,chrCB,intBagCount,intOddment,intAmount,intStorageAmount from v_OutstorageInformation_List where chrCKDH='00'"
  
  Set rsNewTmp = New ADODB.Recordset
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
  Set grdQryResult(0).DataSource = rsNewTmp
  
  Call SetGridheader("出库单号|书号|书名|单价|折扣|册/包|包数|零头|出库数量|库存数", 0)

   
  Exit Sub
Err:
  MsgBox "查询记录失败：" & Err.Description, vbInformation
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  On Error GoTo Err
  Dim strQuery As String
  Dim arrQuery
  
  strQuery = g_CommonSelect("   出库单号   |    出库类型  |  出库库区  |  入库库区  |  总数量  |  总码洋  |  总实洋  |  制单人  |  制单日期  ", "select chrCKDH,ChrOutStorageName,ChrStorageName1,ChrStorageName2," & _
                            "IntTotal,decMY,decSY,chrZDR,datDate from v_OutstorageInformation  order by chrCKDH")
  txtFields(0).Text = strQuery

  Exit Sub
Err:
   MsgBox "查询数据失败：" & Err.Description, vbInformation
End Sub

Private Sub Form_Activate()
  Call ChangeToolBar(frmMain, 7, "审批", 14, "Audit")
  SetToolBar ("0000X01X001X111X1")
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    Call autoreturn(KeyAscii)
End Sub

Private Sub Form_Load()
  Frame2.BackColor = &HF0C0C0
  chkFields(0).BackColor = &HF0C0C0
  chkFields(1).BackColor = &HF0C0C0
  dtpInDate(0).Value = Format(Date, "yyyy-mm-dd")
  dtpInDate(1).Value = Format(Date, "yyyy-mm-dd")
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call ChangeToolBar(frmMain, 7, "刷新", 6, "Refresh")
  SetToolBar ("0000X00X001X111X1")
End Sub



Private Sub lstFields_ItemCheck(ByVal Item As MSComctlLib.ListItem)
  Dim i As Integer
  Dim j As Integer
  Dim strItem As String
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim rsNewTmp As New ADODB.Recordset
  
  On Error GoTo Err
  
  If Item.Checked = True Then
    strWhereCondition = strWhereCondition & "'" & CStr(Item) & "',"
    
  Else
     Call DelTxtItem(strWhereCondition, Trim(CStr(Item)))
  End If
  
  If Trim(strWhereCondition) = "" Then
      sqlstring = "select top 1 chrCKDH,t2.ChrOutStorageName,t3.ChrStorageName,t4.ChrStorageName,t1.decAgio,ChrJBR,intTotal,decMY,decSY,chrRemark,ChrZDR,datDate" & _
              " FROM ((OutstorageInformation t1 left JOIN OutStorageType t2 ON " & _
              "t1.ChrOutStorageNo = t2.ChrOutStorageNo) left JOIN StorageSection t3 ON t1.ChrStorageNo1 = t3.ChrStorageNo) " & _
              "left JOIN StorageSection t4 ON t1.ChrStorageNo2 = t4.ChrStorageNo where chrCKDH='00'"
      Set rstmp = New ADODB.Recordset
      rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      
      Set grdQryResult(1).DataSource = rstmp
      
      Call SetGridheader("出库单号|出库类型|出库库区|入库库区|折扣|经办人|总数量|总码洋|总实洋|备注|制单人|制单日期", 1)
    
      
      sqlstring = "select top 1 chrCKDH,chrBookNo,chrBookName,decPrice,decAgio,chrCB,intBagCount,intOddment,intAmount,intStorageAmount from v_OutstorageInformation_List where chrCKDH='00'"
      
      Set rsNewTmp = New ADODB.Recordset
      rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
      
      Set grdQryResult(0).DataSource = rsNewTmp
      
      Call SetGridheader("出库单号|书号|书名|单价|折扣|册/包|包数|零头|出库数量|库存数", 0)
      Exit Sub
           
  End If
  
  sqlstring = "select chrCKDH,t2.ChrOutStorageName,t3.ChrStorageName,t4.ChrStorageName,t1.decAgio,ChrJBR,intTotal,decMY,decSY,chrRemark,ChrZDR,datDate" & _
              " FROM ((OutstorageInformation t1 left JOIN OutStorageType t2 ON " & _
              "t1.ChrOutStorageNo = t2.ChrOutStorageNo) left JOIN StorageSection t3 ON t1.ChrStorageNo1 = t3.ChrStorageNo) " & _
              "left JOIN StorageSection t4 ON t1.ChrStorageNo2 = t4.ChrStorageNo where chrCKDH in (" & Mid(strWhereCondition, 1, Len(strWhereCondition) - 1) & ")"
  
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
  Set grdQryResult(1).DataSource = rstmp
  
  Call SetGridheader("出库单号|出库类型|出库库区|入库库区|折扣|经办人|总数量|总码洋|总实洋|备注|制单人|制单日期", 1)

  
  sqlstring = "select chrCKDH,chrBookNo,chrBookName,decPrice,decAgio,chrCB,intBagCount,intOddment,intAmount,intStorageAmount from v_OutstorageInformation_List where chrCKDH in (" & Mid(strWhereCondition, 1, Len(strWhereCondition) - 1) & ")"
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
  Set grdQryResult(0).DataSource = rsNewTmp
  
  Call SetGridheader("出库单号|书号|书名|单价|折扣|册/包|包数|零头|出库数量|库存数", 0)

  
  Exit Sub
Err:
  MsgBox "显示记录出错：" & Err.Description, vbInformation
End Sub

'在文本框中删除一列
Private Sub DelTxtItem(ByVal strTxtSql As String, strDelTxtSql As String)

  Dim strTmpsql As String
  
  strTmpsql = Replace(strTxtSql, "'" & strDelTxtSql & "',", " ", 1, , vbTextCompare)
  strWhereCondition = strTmpsql
   
End Sub

'设置TDBGRID的列头
Private Sub SetGridheader(ByVal strHeader As String, intNo As Integer)
  On Error Resume Next
  Dim arrHeader() As String
  Dim i As Integer
  
  arrHeader = Split(strHeader, "|", -1, vbTextCompare)
  For i = 0 To UBound(arrHeader)
     grdQryResult(intNo).Columns(i).Caption = arrHeader(i)
     grdQryResult(intNo).Columns(i).Alignment = dbgRight
     If Not IsDate(grdQryResult(intNo).Columns(i).Value) Then
        If i <> 0 And i <> 1 Then
            grdQryResult(intNo).Columns(i).NumberFormat = "#,##0.00"
        End If
     End If
     '自定义宽度
     grdQryResult(intNo).Columns(i).Width = grdQryResult(intNo).Columns(i).Width * (0.986 * grdQryResult(intNo).Font.Size / 9) + 100
     
  Next i
  
End Sub