frmxsph.frm

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

FRM
1,070
字号
   Case 1
     If chkFields(1).Value = 1 Then
        chkFields(3).Value = 1
        Tdbsale1.Visible = True
        chkFields(2).Visible = True
        cmbFields(1).Visible = True
        chkFields(2).Value = 0
     Else
        chkFields(3).Value = 1
        Tdbsale1.Visible = True
        chkFields(2).Visible = False
        cmbFields(1).Visible = False
         Call clearAll
     End If
   Case 2
     If chkFields(2).Value = 1 Then
        chkFields(3).Value = 1
        TdbSale.Visible = True
        Tdbsale1.Visible = False
     Else
        Tdbsale1.Visible = True
         Call clearAll
     End If
   Case Else
     If chkFields(1).Value = 1 And chkFields(2).Value = 1 Then
        chkFields(3).Value = 1
        TdbSale.Visible = True
     Else
        Tdbsale1.Visible = True
     End If
End Select
End Sub

Private Sub Command1_Click(Index As Integer)
Dim sqlstring As String
Dim rstmp As New ADODB.Recordset
Dim rsNewTmp As New ADODB.Recordset

Dim i As Integer


  For i = 0 To 2
    strSubQuery(i) = ""
  Next i

 Select Case Index
    Case 0
   
        '制品类型
        If chkFields(1).Value = 1 And Trim(cmbFields(0).Text) <> "" Then
            strSubQuery(0) = "t1.ChrProduceType = '" & Trim(cmbFields(0).Text) & "' "
        End If
        
        '图书类型
        If chkFields(2).Value = 1 And Trim(cmbFields(1).Text) <> "" Then
            strSubQuery(1) = "t2.ChrBookType = '" & Trim(cmbFields(1).Text) & "' "
         End If
         
        '日期
        If chkFields(0).Value = 1 Then
            strSubQuery(2) = "(T3.DatDate 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
      
        strQuery(0) = "where "
      
      For i = 0 To 2
         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 '没选任何条件
'         Frame2.Visible = False
         Exit Sub
      Else
         If chkFields(1).Value <> 1 And chkFields(2).Value <> 1 Then
            sqlstring = "select t1.chrproduceType,sum(t1.IntAmount) as IntAmount,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 " & _
                      "ON t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno "
              
            If chkFields(3).Value = 1 Then
                    If Trim(cmbFields(2).Text) = "以销售数量排" Then
                     sqlstring = sqlstring & "group by t1.chrproduceType order by sum(t1.IntAmount) desc"
                    Else
                     sqlstring = sqlstring & "group by t1.chrproduceType order by sum(t1.DecSum) desc"
                    End If
                 Else
                    sqlstring = sqlstring & "group by t1.chrproduceType order by sum(t1.DecSum) desc"
                 End If
                 
           Set rstmp = New ADODB.Recordset
           rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                 sqlstring = "select sum(t1.IntAmount) as IntAmount,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 ON " & _
                         "t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno " & _
                        "" & strQuery(0) & " "
                 Set rsNewTmp = New ADODB.Recordset
                 rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                 
         
                 If Not rsNewTmp.EOF Then
                     Tdbsale1.Columns(1).FooterText = IIf(IsNull(rsNewTmp.Fields("IntAmount")), "", rsNewTmp.Fields("IntAmount"))
                     Tdbsale1.Columns(2).FooterText = IIf(IsNull(rsNewTmp.Fields("DecSum")), "", rsNewTmp.Fields("DecSum"))
                   
                 End If
                              
                    If rstmp.Recordcount = 0 Then
                       MsgBox "没有满足该查询条件的图书记录!", vbInformation
                    Else
                    
                          Call ShowExpRecord1(rstmp, 1)
                     
                    End If
        Else
              If chkFields(2).Value <> 1 Then
              
                 sqlstring = "select t2.chrbookType,sum(t1.IntAmount) as IntAmount,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 " & _
                             "ON t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno " & _
                            "" & strQuery(0) & ""
                            
                 If chkFields(3).Value = 1 Then
                    If Trim(cmbFields(2).Text) = "以销售数量排" Then
                     sqlstring = sqlstring & "group by t2.chrbookType order by sum(t1.IntAmount) desc"
                    Else
                     sqlstring = sqlstring & "group by t2.chrbookType order by sum(t1.DecSum) desc"
                    End If
                 Else
                    sqlstring = sqlstring & "group by t2.chrbookType order by sum(t1.DecSum) desc"
                 End If
                 
                 Set rstmp = New ADODB.Recordset
                 rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                 sqlstring = "select sum(t1.IntAmount) as IntAmount,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 ON " & _
                         "t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno " & _
                        "" & strQuery(0) & " "
                 Set rsNewTmp = New ADODB.Recordset
                 rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                 
         
                 If Not rsNewTmp.EOF Then
                     Tdbsale1.Columns(1).FooterText = IIf(IsNull(rsNewTmp.Fields("IntAmount")), "", rsNewTmp.Fields("IntAmount"))
                     Tdbsale1.Columns(2).FooterText = IIf(IsNull(rsNewTmp.Fields("DecSum")), "", rsNewTmp.Fields("DecSum"))
                   
                 End If
                              
                    If rstmp.Recordcount = 0 Then
                       MsgBox "没有满足该查询条件的图书记录!", vbInformation
                    Else
                    
                          Call ShowExpRecord1(rstmp, 1)
                     
                    End If
        
             Else
                 sqlstring = "select t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,sum(t1.IntAmount) " & _
                            "as IntAmount,t1.DecAgio,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 " & _
                            "ON t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno " & _
                            "" & strQuery(0) & ""
                 If chkFields(3).Value = 1 Then
                    If Trim(cmbFields(2).Text) = "以销售数量排" Then
                     sqlstring = sqlstring & "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.IntAmount) desc"
                    Else
                     sqlstring = sqlstring & "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.DecSum) desc"
                    End If
                 Else
                    sqlstring = sqlstring & "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.DecSum) desc"
                 End If
                  Set rstmp = New ADODB.Recordset
                  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                 
                  sqlstring = "select sum(t1.IntAmount) as IntAmount,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 ON " & _
                              "t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno " & _
                             "" & strQuery(0) & " "
                 Set rsNewTmp = New ADODB.Recordset
                 rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                 
         
                 If Not rsNewTmp.EOF Then
                     TdbSale.Columns(4).FooterText = IIf(IsNull(rsNewTmp.Fields("IntAmount")), "", rsNewTmp.Fields("IntAmount"))
                     TdbSale.Columns(6).FooterText = IIf(IsNull(rsNewTmp.Fields("DecSum")), "", rsNewTmp.Fields("DecSum"))
                   
                 End If
                              
                    If rstmp.Recordcount = 0 Then
                       MsgBox "没有满足该查询条件的图书记录!", vbInformation
                    Else
                    
                          Call ShowExpRecord(rstmp, 1)
                     
                    End If
             End If
        
       End If
          
 End If

' Frame2.Visible = False
 End Select
End Sub
Private Sub Form_Activate()
  SetToolBar ("0000X00X011X111X1")
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

    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(0)) <> "" Then
          If chkFields(1).Value <> 1 And chkFields(2).Value <> 1 Then
            sqlstring = "select t1.chrproduceType,sum(t1.IntAmount) as IntAmount,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 " & _
                      "ON t1.chrbookno=t2.chrbookno and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno "
              
            If chkFields(3).Value = 1 Then
               If Trim(cmbFields(2).Text) = "以销售数量排" Then
                sqlstring = sqlstring & "group by t1.chrproduceType order by sum(t1.IntAmount) desc"
               Else
                sqlstring = sqlstring & "group by t1.chrproduceType order by sum(t1.DecSum) desc"
               End If
            Else
               sqlstring = sqlstring & "group by t1.chrproduceType order by sum(t1.DecSum) desc"
            End If
          Else
                 If chkFields(2).Value = 1 Then
                    sqlstring = "select t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,sum(t1.IntAmount) as IntAmount," & _
                                "t1.DecAgio,sum(t1.DecSum) as DecSum from (SellTable_List t1 left join bookdata t2 ON t1.chrbookno=t2.chrbookno " & _
                                "and t1.chrbookname=t2.chrbookname) left join selltable t3 ON t1.chrsellno=t3.chrsellno " & _
                                "" & strQuery(0) & " "
            
                    If chkFields(3).Value = 1 Then
                       If Trim(cmbFields(2).Text) = "以销售数量排" Then
                        sqlstring = sqlstring & "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.IntAmount) desc"
                       Else
                        sqlstring = sqlstring & "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.DecSum) desc"
                       End If
                    Else
                       sqlstring = sqlstring & "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.DecSum) desc"
                    End If

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?