frmkcfx.frm

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

'         cmdSearch(1).Enabled = True
'      Else
'         cmdSearch(1).Enabled = False
'      End If
'    End Select
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cmdOK_Click(Index As Integer)
Dim sqlstring As String
Dim sqlstring1 As String
Dim sqlstring2 As String
Dim Amount As Integer
Dim Amount1 As Integer
Dim Amount2 As Integer
Dim Amount3 As Integer
Dim rstmp As New ADODB.Recordset
Dim i As Integer
Dim rsNewTmp As New ADODB.Recordset
Dim rsnewtmp1 As New ADODB.Recordset
Dim rs As New ADODB.Recordset
For i = 0 To 2
    strSubQuery(i) = ""
Next


If Option1(0).Value = True Then
   If chkFields(0).Value = 1 Then
       sqlstring = "select top 1 * from PDControl"
        Set rs = New ADODB.Recordset
        rs.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If Not rs.EOF Then
         sqlstring = "select sum(intAmount) as intAmounts from pdresult where chrPDDate=#" & Format(rs.Fields("DatLast"), "yyyy-mm-dd") & "#"
          Set rstmp = New ADODB.Recordset
          rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
       
            If Not rstmp.EOF Then
'                MsgBox "没有满足该查询条件的图书记录！", vbInformation
                Amount1 = IIf(IsNull(rstmp("intAmounts").Value), "0", rstmp("intAmounts").Value)
            
            End If
          End If
        sqlstring1 = "select sum(t1.intSSS) as intssss from InstorageInformation_List t1 left join InstorageInformation t2 on t1.chrRKDH=t2.chrRKDH where T2.DatCheckDate between #" & Format(rs.Fields("DatLast"), "yyyy-mm-dd") & "# and #" & Format(dtpDate(4).Value, "yyyy-mm-dd") & "# "
         Set rsNewTmp = New ADODB.Recordset
         rsNewTmp.Open sqlstring1, cN, adOpenKeyset, adLockReadOnly
            If Not rsNewTmp.EOF Then
                 Amount2 = IIf(IsNull(rsNewTmp("intssss").Value), "0", rsNewTmp("intssss").Value)
                
            Else
                MsgBox "没有满足该查询条件的图书记录！", vbInformation
            End If

        sqlstring2 = "select sum(t1.intAmount) as intAmountss from OutstorageInformation_List t1 left join OutstorageInformation t2 on t1.chrCKDH=t2.chrCKDH where T2.DatSPDate between #" & Format(rs.Fields("DatLast"), "yyyy-mm-dd") & "# and #" & Format(dtpDate(4).Value, "yyyy-mm-dd") & "#"
        Set rsnewtmp1 = New ADODB.Recordset
        rsnewtmp1.Open sqlstring2, cN, adOpenKeyset, adLockReadOnly
        If Not rsnewtmp1.EOF Then
             Amount3 = IIf(IsNull(rsnewtmp1("intAmountss").Value), "0", rsnewtmp1("intAmountss").Value)
        Else
            MsgBox "没有满足该查询条件的图书记录！", vbInformation
        End If
        
        Amount = Amount1 + Amount2 - Amount3
       
       X.ReDim 0, 0, 0, 1
       X(0, 0) = Format(dtpDate(4).Value, "yyyy-mm-dd")
       X(0, 1) = Amount
       Set TdbStorage.Array = X
       TdbStorage.ReBind
    Else
        Exit Sub
   
End If
End If
If Option1(1).Value = True Then

    '时间
    If chkFields(2).Value = 1 Then
            strSubQuery(0) = "(t2.DatCheckDate between #" & Format(dtpDate(0).Value, "yyyy-mm-dd") & "# and #" & Format(dtpDate(1).Value, "yyyy-mm-dd") & "#)"
        End If
          If dtpDate(0).Value > dtpDate(1).Value Then
                MsgBox "请正确选择时间！", vbInformation
              Exit Sub
            End If
     '图书类型
    If chkFields(3).Value = 1 And Trim(cmbFields(1).Text) <> "" Then
       strSubQuery(1) = "t3.ChrBookType = '" & Trim(cmbFields(1).Text) & "' "
    End If
      
        strQuery(1) = "where "
      
      For i = 0 To 1
         If Trim(strSubQuery(i)) <> "" Then
           strQuery(1) = strQuery(1) & strSubQuery(i) & " and "
         End If
         
      Next
      
        If Trim(strQuery(1)) = "where" Then
            strQuery(1) = strQuery(1) & " 2=2 and "
        End If
        
        strQuery(1) = Mid(strQuery(1), 1, Len(strQuery(1)) - 4)
      
      If Trim(strQuery(1)) = "where" Then '没选任何条件
'         Frame3.Visible = False
         Exit Sub
      Else
         
         sqlstring = "SELECT t1.ChrBookNo, t1.ChrBookName,t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount, " & _
                    "sum(t1.IntLDS), sum(t1.IntSSS) ,(t1.DecPrice*t1.DecAgio*sum(t1.IntSSS)) as jine  FROM (InStorageInformation t2 inner JOIN InstorageInformation_List t1 ON t2.ChrRKDH = t1.ChrRKDH) " & _
                    "left join bookdata t3 ON t1.chrbookno=t3.chrbookno and t1.chrbookname=t3.chrbookname  " & strQuery(1) & " group by t1.ChrBookNo, t1.ChrBookName," & _
                    "t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount order by sum(t1.IntSSS) desc"
        Set rstmp = New ADODB.Recordset
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
         
        sqlstring = "select sum(IntLD),sum(IntSS),sum(jine) from (SELECT t1.ChrBookNo, t1.ChrBookName,t3.ChrBookType, " & _
                    "t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount, sum(t1.IntLDS) as IntLD, sum(t1.IntSSS) as IntSS , " & _
                    "(t1.DecPrice*t1.DecAgio*sum(t1.IntSSS)) as jine  FROM (InStorageInformation t2 inner JOIN InstorageInformation_List " & _
                    "t1 ON t2.ChrRKDH = t1.ChrRKDH) left join bookdata t3 ON t1.chrbookno=t3.chrbookno and t1.chrbookname=t3.chrbookname  " & strQuery(1) & " " & _
                    "group by t1.ChrBookNo, t1.ChrBookName,t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount order by sum(t1.IntSSS) desc)"
        Set rsNewTmp = New ADODB.Recordset
        rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If Not rsNewTmp.EOF Then
           tdbInStorage.Columns(7).FooterText = IIf(IsNull(rsNewTmp.Fields(0)), "", rsNewTmp.Fields(0))
           tdbInStorage.Columns(8).FooterText = IIf(IsNull(rsNewTmp.Fields(1)), "", rsNewTmp.Fields(1))
           tdbInStorage.Columns(9).FooterText = IIf(IsNull(rsNewTmp.Fields(2)), "", rsNewTmp.Fields(2))
        End If
                 
        If rstmp.Recordcount = 0 Then
             MsgBox "没有满足该查询条件的图书记录！", vbInformation
          Else
          
                Call ShowExpRecord(rstmp, 1)
           
          End If
     
    End If
'    Frame3.Visible = False
End If

If Option1(2).Value = True Then
     '时间
     If chkFields(5).Value = 1 Then
            strSubQuery(0) = "(t2.DatSPDate between #" & Format(dtpDate(2).Value, "yyyy-mm-dd") & "# and #" & Format(dtpDate(3).Value, "yyyy-mm-dd") & "#)"
        End If
        If dtpDate(2).Value > dtpDate(3).Value Then
                MsgBox "请正确选择时间！", vbInformation
              Exit Sub
        End If
        strQuery(2) = "where "
      
      For i = 0 To 1
         If Trim(strSubQuery(i)) <> "" Then
           strQuery(2) = strQuery(2) & strSubQuery(i) & " and "
         End If
         
      Next
      
        If Trim(strQuery(2)) = "where" Then
            strQuery(2) = strQuery(2) & " 2=2 and "
        End If
        
        strQuery(2) = Mid(strQuery(2), 1, Len(strQuery(2)) - 4)
      
      If Trim(strQuery(2)) = "where" Then '没选任何条件
'         Frame4.Visible = False
         Exit Sub
      Else
      
      sqlstring = "SELECT t1.ChrBookNo, t1.ChrBookName, t1.DecPrice, t1.DecAgio,t1.ChrCB, t1.IntBagCount, sum(t1.IntAmount) " & _
                "FROM OutstorageInformation t2 left JOIN OutstorageInformation_List t1 ON t2.ChrCKDH = t1.ChrCKDH  " & strQuery(2) & "  group by t1.ChrBookNo, " & _
                "t1.ChrBookName, t1.DecPrice, t1.DecAgio,t1.ChrCB, t1.IntBagCount order by sum(t1.IntAmount) desc"
        Set rstmp = New ADODB.Recordset
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
    sqlstring = "select sum(t1.IntAmount) " & _
                "FROM OutstorageInformation t2 left JOIN OutstorageInformation_List t1 ON t2.ChrCKDH = t1.ChrCKDH  " & strQuery(2) & " "
        Set rsNewTmp = New ADODB.Recordset
        rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If Not rsNewTmp.EOF Then
           tdbOutStorage.Columns(6).FooterText = IIf(IsNull(rsNewTmp.Fields(0)), "", rsNewTmp.Fields(0))
        End If
        
        If rstmp.Recordcount = 0 Then
             MsgBox "没有满足该查询条件的图书记录！", vbInformation
          Else
          
                Call ShowExpRecord(rstmp, 1)
           
        End If
 
    End If
'    Frame4.Visible = False
End If

End Sub
Public Sub cmdPrint_Click()
    Dim frm As New frmModCommonPrint
    Dim rstmp As New ADODB.Recordset
    Dim sqlstring As String
    Dim p As New ClsPrintInfo
    Dim arr, r&, c&
    Dim strAboveTable$, strBelowTable$, strSign$
    On Error GoTo err

'  If Not checkpermission("书店管理系统", strUserName, , "统计分析.销售排行.打印") Then
'       Exit Sub
'  End If
If Option1(0).Value = True Then
    Exit Sub
End If

'入库
If Option1(1).Value = True Then
With p
        
        '标题
        .cqFirstTitle.Content = "入库"
        .cqFirstTitle.FontSize = 18
        .cqFirstTitle.FontBold = True
        
        '表前叙述
                   
        .cqSayingAboveTable.Content = "打印于：|" & Format(Date, "yyyy-MM-dd")
        .cqSayingAboveTable.LayOut = "Body align=left cols=3 interwidth=50 |label align=left width=16|text align=left width=20"
                
   If Trim(strQuery(1)) <> "" Then
    
            sqlstring = "SELECT t1.ChrBookNo, t1.ChrBookName,t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount, " & _
                        "sum(t1.IntLDS), sum(t1.IntSSS) ,(t1.DecPrice*t1.DecAgio*sum(t1.IntSSS)) as jine  FROM (InStorageInformation t2 inner JOIN InstorageInformation_List t1 ON t2.ChrRKDH = t1.ChrRKDH) " & _
                        "left join bookdata t3 ON t1.chrbookno=t3.chrbookno and t1.chrbookname=t3.chrbookname  " & strQuery(1) & " group by t1.ChrBookNo, t1.ChrBookName," & _
                        "t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount order by sum(t1.IntSSS) desc"
      Else

            sqlstring = "SELECT t1.ChrBookNo, t1.ChrBookName,t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount, " & _
                        "sum(t1.IntLDS), sum(t1.IntSSS) ,(t1.DecPrice*t1.DecAgio*sum(t1.IntSSS)) as jine  FROM (InStorageInformation t2 inner JOIN InstorageInformation_List t1 ON t2.ChrRKDH = t1.ChrRKDH) " & _
                        "left join bookdata t3 ON t1.chrbookno=t3.chrbookno and t1.chrbookname=t3.chrbookname  group by t1.ChrBookNo, t1.ChrBookName," & _
                        "t3.ChrBookType,t1.DecPrice, t1.DecAgio,t1.ChrCB,t1.IntBagCount order by sum(t1.IntSSS) desc"

      End If
       Set rstmp = New ADODB.Recordset
       rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.Recordcount > 0 Then
        arr = rstmp.GetRows
       End If

        .cqTable.Content = arr
        .cqTable.LayOut = " Format=^80|100|100|100;#,##0.00|100|100|100|100;#,##0|100;#,##0|100;#,##0.00" & _
                          " Header=书号|书名|图书类型|单价|折扣|册/包|包装|来单数|实收数|金额" & _
                          " Subtotal=2\页总计\1\8\8\1\#,##0\2-1\1;1\总计\1\8\8\1\#,##0\2-1\2;" & _
                                   "2\页总计\1\9\9\1\#,##0\2-1\1;1\总计\1\9\9\1\#,##0\2-1\2;" & _
                                   "2\页总计\1\10\10\1\#,##0.00\2-1\1;1\总计\1\10\10\1\#,##0.00\2-1\2"
        
        '采用传句柄方式
        '.cqTable.Hwnd = Me.grdDetail.Hwnd
    End With
        
    With frm
        Set .PrintInfo = p
        '设置重复打印部分
        Call .setRepeat(cp_RepeatView_All)
        '设置表格填充空行
        '.blnEmptyRow = True
        '设置表格最后行拉伸到满页
        '.blnExtenLastCol = True
        '设置表格自动调整列宽到满页
        .blnColumnForPage = True
        '设置汇总高度，视汇总行数而定
        .SubTotal_Height = 600
        '设置页高、页宽、行高及最大页数
        '.MaxRowsPerPage = 10
        '.Row_Height = 300
        .TopHeader_Height = 1
        .SubTotal_Height = 600
        .ParagraphInterRate = 0.4
        .PrintPaperSize = pprEnv9
        '设置打印信息保存位置
        .strPrintInfoName = "入库|" & Me.Caption
        
        .FormStart
        .Show vbModal
    End With
    Exit Sub
End If

'出库
If Option1(2).Value = True Then
With p
        
        '标题
        .cqFirstTitle.Content = "出库"
        .cqFirstTitle.FontSize = 18
        .cqFirstTitle.FontBold = True