frmxsph.frm

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

                Else
                   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
                End If
             End If
      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 group by t1.chrproduceType order by sum(t1.DecSum) desc"
            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 " & _
                          "group by t1.ChrBookNo,t1.ChrBookName,t2.chrbookType,t1.DecPrice,t1.DecAgio order by sum(t1.DecSum) desc"
              Else
                  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 " & _
                              "group by t2.chrbookType order by sum(t1.DecSum) desc"
              End If
         End If
    End If
       Set rstmp = New ADODB.Recordset
       rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        If rstmp.Recordcount > 0 Then
            arr = rstmp.GetRows
       End If
       
    If chkFields(1).Value <> 1 And chkFields(2).Value <> 1 Then
        .cqTable.Content = arr
        .cqTable.LayOut = " Format=^80|100;#,##0|100;#,##0.00" & _
                          " Header=图书类型|数量|金额" & _
                          " Subtotal=2\页总计\1\2\2\1\#,##0\1-0\1;1\总计\1\2\2\1\#,##0\1-0\2;" & _
                                   "2\页总计\1\3\3\1\#,##0.00\1-0\1;1\总计\1\3\3\1\#,##0.00\1-0\2"
      
    Else
        If chkFields(2).Value = 1 Then
        .cqTable.Content = arr
        .cqTable.LayOut = " Format=^80|100|100|100;#,##0.00|100;#,##0|100;#,##0.00|100;#,##0.00" & _
                          " Header=书号|书名|图书类型|单价|数量|折扣|金额" & _
                          " Subtotal=2\页总计\1\5\5\1\#,##0\1-0\1;1\总计\1\5\5\1\#,##0\1-0\2;" & _
                                   "2\页总计\1\7\7\1\#,##0.00\1-0\1;1\总计\1\7\7\1\#,##0.00\1-0\2"
                                    
  
        Else
        .cqTable.Content = arr
        .cqTable.LayOut = " Format=^80|100;#,##0|100;#,##0.00" & _
                          " Header=图书类型|数量|金额" & _
                          " Subtotal=2\页总计\1\2\2\1\#,##0\1-0\1;1\总计\1\2\2\1\#,##0\1-0\2;" & _
                                   "2\页总计\1\3\3\1\#,##0.00\1-0\1;1\总计\1\3\3\1\#,##0.00\1-0\2"
                                    
        End If
    End If
            
            '采用传句柄方式
            '.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 File As Node
  Dim Recordcount As Integer
  Dim strNo As String
  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")
  
    '制品类型
   sqlstring = "select * from ProduceType order by ChrProduceNo"
   Set rstmp = New ADODB.Recordset
   rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
   cmbFields(0).Text = "图书"
   Do While Not rstmp.EOF
      cmbFields(0).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(1).Text = "保险"
   Do While Not rstmp.EOF
      cmbFields(1).AddItem rstmp.Fields("ChrBookType")
      rstmp.MoveNext
   Loop

  cmbFields(2).Text = "以销售数量排"
  cmbFields(2).AddItem "以销售数量排", 0
  cmbFields(2).AddItem "以销售金额排", 1


    X.ReDim 0, -1, 0, 6
    Set TdbSale.Array = X
    
    X.ReDim 0, -1, 0, 2
    Set Tdbsale1.Array = X
    

'
'  If ShowRecord(strParent, 1) Then
'     setFormState (ModNormal)
'  End If
  
  Frame2.Visible = True
  
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, 6
             TdbSale.ReBind
          Case 1
    '         MsgBox "没有该图书、文具类型的记录", vbOKOnly, "警告"
             X.ReDim 0, rstmp.Recordcount - 1, 0, 6
             TdbSale.ReBind
        End Select
        
        Exit Function
    End If
    
   
    X.ReDim 0, rstmp.Recordcount - 1, 0, 6
    
    rstmp.MoveFirst
    intRow = 0
    Do While Not rstmp.EOF
        For intCol = 0 To 6

             X(intRow, intCol) = IIf(IsNull(rstmp.Fields(intCol).Value), "", rstmp.Fields(intCol).Value)
             
        Next intCol
        rstmp.MoveNext
        intRow = intRow + 1
    Loop
    
    TdbSale.ReBind
    
    gUpperBound = X.UpperBound(1)
    
    DoEvents
    ShowExpRecord = True
End Function

'显示指定的制品记录
Private Function ShowExpRecord1(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
    
    ShowExpRecord1 = False
    

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

             X(intRow, intCol) = IIf(IsNull(rstmp.Fields(intCol).Value), "", rstmp.Fields(intCol).Value)
             
        Next intCol
        rstmp.MoveNext
        intRow = intRow + 1
    Loop
    
    Tdbsale1.ReBind
    
    gUpperBound = X.UpperBound(1)
    
    DoEvents
    ShowExpRecord1 = True
End Function

Private Sub clearAll()          '清除所有可填数据的位置

    X.ReDim 0, -1, 0, 6
    TdbSale.ReBind
    
    X.ReDim 0, -1, 0, 2
    Tdbsale1.ReBind
    
    TdbSale.Columns(4).FooterText = ""
    TdbSale.Columns(6).FooterText = ""
    Tdbsale1.Columns(1).FooterText = ""
    Tdbsale1.Columns(2).FooterText = ""
    
    dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
    dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
    
End Sub