frmytjb.frm

通用书店管理系统

            sqlstring = sqlstring & "group by t3.Datdate,t1.chrproduceType,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
                     Tdbtongji.Columns(3).FooterText = IIf(IsNull(rsNewTmp.Fields("IntAmount")), "", rsNewTmp.Fields("IntAmount"))
                     Tdbtongji.Columns(4).FooterText = IIf(IsNull(rsNewTmp.Fields("DecSum")), "", rsNewTmp.Fields("DecSum"))
                   
                 End If
                              
                    If rstmp.Recordcount = 0 Then
                       MsgBox "没有满足该查询条件的图书记录！", vbInformation
                       Call clearAll
                    Else
                    
                          Call ShowExpRecord(rstmp, 1)
                     
                    End If
      End If
End Select
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
        sqlstring = "select t3.Datdate,t1.chrproduceType,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(4).Value = 1 Then
            If Trim(cmbFields(3).Text) = "以销售数量排" Then
                 sqlstring = sqlstring & "group by t3.Datdate,t1.chrproduceType,t2.chrbooktype order by sum(t1.IntAmount) desc"
            Else
                 sqlstring = sqlstring & "group by t3.Datdate,t1.chrproduceType,t2.chrbooktype order by sum(t1.DecSum) desc"
            End If
        Else
            sqlstring = sqlstring & "group by t3.Datdate,t1.chrproduceType,t2.chrbooktype order by sum(t1.DecSum) desc"
        End If
      Else
         
        sqlstring = "select t3.Datdate,t1.chrproduceType,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 " & _
                      "group by t3.Datdate,t1.chrproduceType,t2.chrbooktype order by sum(t1.DecSum) 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=^100|100|100|100;#,##0.00|100;#,##0.00" & _
                          " Header=时间|制品类型|图书类型|数量|金额" & _
                          " Subtotal=2\页总计\1\4\4\1\#,##0\1-0\1;1\总计\1\4\4\1\#,##0\1-0\2;" & _
                                   "2\页总计\1\5\5\1\#,##0.00\1-0\1;1\总计\1\5\5\1\#,##0.00\1-0\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
 
err:
    MsgBox "打印出错！"
End Sub
Private Sub Form_Load()
 Dim sqlstring As String
 Dim rstmp As New ADODB.Recordset
  
  On Error Resume Next
  
  dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(2).Value = Format(Date, "yyyy-mm")
  
    '制品类型
   sqlstring = "select * from ProduceType order by ChrProduceNo"
   Set rstmp = New ADODB.Recordset
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   cmbFields(1).Text = "图书"
   Do While Not rstmp.EOF
      cmbFields(1).AddItem rstmp.Fields("ChrProduceType")
      rstmp.MoveNext
   Loop

    '图书类型
   sqlstring = "select * from BookType order by ChrBookTypeNo"
   Set rstmp = New ADODB.Recordset
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   cmbFields(2).Text = "保险"
   Do While Not rstmp.EOF
      cmbFields(2).AddItem rstmp.Fields("ChrBookType")
      rstmp.MoveNext
   Loop

  cmbFields(0).Text = "年份"
  cmbFields(0).AddItem "年份", 0
  cmbFields(0).AddItem "月份", 1
'  cmbFields(0).AddItem "周", 2
  
  cmbFields(3).Text = "以销售数量排"
  cmbFields(3).AddItem "以销售数量排", 0
  cmbFields(3).AddItem "以销售金额排", 1
  
    X.ReDim 0, -1, 0, 4
    Set Tdbtongji.Array = X
End Sub
Private Sub Form_Activate()
  SetToolBar ("0000X00X011X111X1")
End Sub
'显示指定的制品记录
Private Function ShowExpRecord(ByVal rstmp As ADODB.Recordset, intFlag As Integer) As Boolean    'True for success
    On Error Resume Next
    Dim i As Integer
    Dim strSQL As String
    Dim intRow, intCol As Integer
    
    ShowExpRecord = False
    

    If rstmp.EOF Then
        Select Case intFlag
          Case 0
    '         MsgBox "没有该制品类型的记录", vbOKOnly, "警告"
             X.ReDim 0, rstmp.Recordcount - 1, 0, 4
             Tdbtongji.ReBind
          Case 1
    '         MsgBox "没有该图书、文具类型的记录", vbOKOnly, "警告"
             X.ReDim 0, rstmp.Recordcount - 1, 0, 4
             Tdbtongji.ReBind
        End Select
        
        Exit Function
    End If
    
   
    X.ReDim 0, rstmp.Recordcount - 1, 0, 4
    
    rstmp.MoveFirst
    intRow = 0
    Do While Not rstmp.EOF
        For intCol = 0 To 4

             X(intRow, intCol) = IIf(IsNull(rstmp.Fields(intCol).Value), "", rstmp.Fields(intCol).Value)
             
        Next intCol
        rstmp.MoveNext
        intRow = intRow + 1
    Loop
    
    Tdbtongji.ReBind
    
    gUpperBound = X.UpperBound(1)
    
    DoEvents
    ShowExpRecord = True
End Function
Private Sub clearAll()          '清除所有可填数据的位置

    X.ReDim 0, -1, 0, 4
    Tdbtongji.ReBind
    
    Tdbtongji.Columns(3).FooterText = ""
    Tdbtongji.Columns(4).FooterText = ""
    
    
    dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(2).Value = Format(Date, "yyyy-mm-dd")
End Sub
Private Sub Tdbtongji_HeadClick(ByVal ColIndex As Integer)
    Select Case ColIndex
     Case 0
        If blnOrder(ColIndex) Then
           X.QuickSort 0, X.UpperBound(1), ColIndex, XORDER_ASCEND, XTYPE_DATE
           blnOrder(ColIndex) = Not blnOrder(ColIndex)
        Else
           X.QuickSort 0, X.UpperBound(1), ColIndex, XORDER_DESCEND, XTYPE_DATE
           blnOrder(ColIndex) = Not blnOrder(ColIndex)
        End If
     Case Else
        If blnOrder(ColIndex) Then
           X.QuickSort 0, X.UpperBound(1), ColIndex, XORDER_ASCEND, XTYPE_STRING
           blnOrder(ColIndex) = Not blnOrder(ColIndex)
        Else
           X.QuickSort 0, X.UpperBound(1), ColIndex, XORDER_DESCEND, XTYPE_STRING
           blnOrder(ColIndex) = Not blnOrder(ColIndex)
        End If
   End Select
   
   Tdbtongji.ReBind
End Sub