frmhistorystoragequery.frm

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

                   
        .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"
        
       sqlstring = "select A.chrStorageName,A.chrProduceType,A.chrBookType,A.intTotalAmount,A.decTotalMoney,A.decTotalFactMoney," & _
              " A.intTotalAmount/B.intTotalAmount*100 as decPercentAmount ,A.decTotalMoney/B.decTotalMoney*100 as decPercentMoney," & _
              "A.decTotalFactMoney/B.decTotalFactMoney *100 as decPercentFactMoney From (select chrStorageName,chrProduceType,chrBookType," & _
              " sum(IntAmount) as intTotalAmount,sum(decMoney) as decTotalMoney,sum(decFactMoney) as decTotalFactMoney From " & _
              "(SELECT T2.ChrStorageName, T3.ChrProduceType, T3.ChrBookType,  T1.IntAmount,  T3.DecPrice* T1.IntAmount as decMoney," & _
              " T3.DecAgio*T3.decPrice*T1.IntAmount as decFactMoney FROM (PDResult T1 Left JOIN BookData T3 ON " & _
              "(T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo)) Left JOIN StorageSection T2 ON " & _
              "T1.ChrStorageNo = T2.ChrStorageNo Where ChrPDDate=#" & strDate & "#)" & _
              "A Group by chrStorageName,chrProduceType,chrBookType )A Left Join (select chrStorageName,chrProduceType,sum(IntAmount) as intTotalAmount," & _
              " sum(decMoney) as decTotalMoney,sum(decFactMoney) as decTotalFactMoney From (SELECT T2.ChrStorageName," & _
              "T3.ChrProduceType, T3.ChrBookType,  T1.IntAmount,  T3.DecPrice* T1.IntAmount as decMoney,  T3.DecAgio*T3.decPrice*T1.IntAmount as decFactMoney" & _
              " FROM (PDResult T1 Left JOIN BookData T3 ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo)) Left JOIN StorageSection T2" & _
              " ON T1.ChrStorageNo = T2.ChrStorageNo Where ChrPDDate=#" & strDate & "#) A Group by chrStorageName,chrProduceType)B on " & _
              "(A.chrStorageName=B.chrStorageName) and (A.chrProduceType=B.chrProduceType)"
       
       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|100;#,##0.00|100;#,##0.00|100;#,##0.00|100;#,##0.00|100;#,##0.00" & _
                          " Header=库区|制品类型|图书类型|库存数量|码洋|实洋|库存数量%|码洋%|实洋%" & _
                          " Subtotal=2\页总计\1\4\4\1\#,##0\2-1\1;1\总计\1\4\4\1\#,##0\2-1\2;" & _
                                    "2\页总计\1\5\5\1\#,##0.00\2-1\1;1\总计\1\5\5\1\#,##0.00\2-1\2;" & _
                                   "2\页总计\1\6\6\1\#,##0.00\2-1\1;1\总计\1\6\6\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 Select
err:
    MsgBox "打印出错！"
End Sub

Private Sub cmdSearch_Click(Index As Integer)
  Dim arrQuery
  Dim i As Integer
  
  Select Case Index
    Case 0
      Frame1(0).Visible = True
    Case 2
      Call g_CommonSelect("  库区号  |  库区  ", "select chrStorageNo,chrStorageName from StorageSection where chrStorageNo like '%" & txtFields(1).Text & "%'", "0,1", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
              txtFields(0).Text = ""
              For i = 0 To UBound(arrQuery)
                 txtFields(0).Text = txtFields(0).Text & "" & arrQuery(i, 0) & ","
              Next
              txtFields(0).Text = Mid(txtFields(0).Text, 1, Len(txtFields(0).Text) - 1)
      End If
    Case 3
      Call g_CommonSelect("  库区号  |  库区  ", "select chrBookTypeNo,chrBookType from BookType ", "0,1", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
              txtFields(1).Text = ""
              For i = 0 To UBound(arrQuery)
                 txtFields(1).Text = txtFields(1).Text & "" & arrQuery(i, 1) & ","
              Next
              txtFields(1).Text = Mid(txtFields(1).Text, 1, Len(txtFields(1).Text) - 1)
      End If
    Case 4
        Call g_CommonSelect("   出版社编码   |    出版社    ", "select chrCompanyNo,ChrCompanyName from PublishingCompanyData where chrCompanyNo like'%" & txtFields(2).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(2).Text = arrQuery(0, 1)
              a = arrQuery(0, 0)
        End If
    Case 5
        Call g_CommonSelect("   供货商编码   |    供货商名称   |   联系人  |  地址  ", "select chrClientNo,chrClientName,chrLinkman,chrAddress from ClientData where intFlag=0 and chrClientNo like '%" & txtFields(3).Text & "%'", "0,1", , , , -1, arrQuery)
      If TypeName(arrQuery) = "Variant()" Then
              txtFields(3).Text = arrQuery(0, 1)
              a = arrQuery(0, 0)
        End If
    Case 6 '书号
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & txtFields(4).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(4).Text = arrQuery(0, 0)
              txtFields(5).Text = arrQuery(0, 1)
        End If
    Case 7 '书名
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookName like '%" & txtFields(5).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(4).Text = arrQuery(0, 0)
              txtFields(5).Text = arrQuery(0, 1)
        End If
  End Select
End Sub

Private Sub Form_Activate()
  SetToolBar ("0000X00X011X111")
End Sub

Private Sub Form_Load()
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim rsNewTmp As New ADODB.Recordset
  Dim strFoot As String
  
  Frame1(0).Visible = True
  
'  '明细
'  sqlstring = "SELECT T2.ChrStorageName, T1.ChrBookNo,  T1.ChrBookName,  T1.IntAmount,  T3.DecPrice* T1.IntAmount as decMoney,  T3.DecAgio*T3.decPrice*T1.IntAmount as decFactMoney,  T3.ChrProduceType," & _
'               "T3.ChrBookType, T3.ChrAuthoer, T4.ChrCompanyName FROM ((PDResult T1 Left JOIN BookData T3 ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo)) Left JOIN " & _
'               "StorageSection T2 ON T1.ChrStorageNo = T2.ChrStorageNo) left JOIN  PublishingCompanyData T4 ON T3.chrbookconcern = T4.chrCompanyName Where ChrPDDate=#" & strDate & "#"
'  Set rstmp = New ADODB.Recordset
'  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'  Set tdbQuery(0).DataSource = rstmp
'
'  sqlstring = "SELECT sum(T1.intAmount),sum(T3.DecPrice* T1.IntAmount),  sum(T3.DecAgio*T3.decPrice*T1.IntAmount) " & _
'               "FROM ((PDResult T1 Left JOIN BookData T3 ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo)) Left JOIN " & _
'               "StorageSection T2 ON T1.ChrStorageNo = T2.ChrStorageNo) left JOIN  PublishingCompanyData T4 ON T3.chrbookconcern = T4.chrCompanyName Where ChrPDDate=#" & strDate & "#"
'  Set rsNewTmp = New ADODB.Recordset
'  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'
'  If Not rsNewTmp.EOF Then
'    strFoot = "|||" & Format(rsNewTmp.Fields(0), "#,##0") & "| " & Format(rsNewTmp.Fields(1), "#,##0.00") & "| " & Format(rsNewTmp.Fields(2), "#,##0.00") & _
'              "|||||"
'  Else
'    strFoot = "||||||||||||"
'  End If
'  Call SetGridheader("库区|书号|书名|数量|码洋|实洋|制品类型|图书类型|作者|出版社|供货商", 0, "7|15|25|15|15|15|10|13|8|15|15", strFoot)
  
  '汇总
  sqlstring = "select A.chrStorageName,A.chrProduceType,A.chrBookType,A.intTotalAmount,A.decTotalMoney,A.decTotalFactMoney," & _
              " A.intTotalAmount/B.intTotalAmount*100 as decPercentAmount ,A.decTotalMoney/B.decTotalMoney*100 as decPercentMoney," & _
              "A.decTotalFactMoney/B.decTotalFactMoney *100 as decPercentFactMoney From (select chrStorageName,chrProduceType,chrBookType," & _
              " sum(IntAmount) as intTotalAmount,sum(decMoney) as decTotalMoney,sum(decFactMoney) as decTotalFactMoney From " & _
              "(SELECT T2.ChrStorageName, T3.ChrProduceType, T3.ChrBookType,  T1.IntAmount,  T3.DecPrice* T1.IntAmount as decMoney," & _
              " T3.DecAgio*T3.decPrice*T1.IntAmount as decFactMoney FROM (PDResult T1 Left JOIN BookData T3 ON " & _
              "(T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo)) Left JOIN StorageSection T2 ON " & _
              "T1.ChrStorageNo = T2.ChrStorageNo Where ChrPDDate=#" & strDate & "#)" & _
              "A Group by chrStorageName,chrProduceType,chrBookType )A Left Join (select chrStorageName,chrProduceType,sum(IntAmount) as intTotalAmount," & _
              " sum(decMoney) as decTotalMoney,sum(decFactMoney) as decTotalFactMoney From (SELECT T2.ChrStorageName," & _
              "T3.ChrProduceType, T3.ChrBookType,  T1.IntAmount,  T3.DecPrice* T1.IntAmount as decMoney,  T3.DecAgio*T3.decPrice*T1.IntAmount as decFactMoney" & _
              " FROM (PDResult T1 Left JOIN BookData T3 ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo)) Left JOIN StorageSection T2" & _
              " ON T1.ChrStorageNo = T2.ChrStorageNo Where ChrPDDate=#" & strDate & "#) A Group by chrStorageName,chrProduceType)B on " & _
              "(A.chrStorageName=B.chrStorageName) and (A.chrProduceType=B.chrProduceType)"
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Set tdbQuery(1).DataSource = rstmp
  
  
  Call SetGridheader("库区|制品类型|图书类型|库存数量|码洋|实洋|库存数量%|码洋%|实洋%", 1, "8|10|15|15|15|15|8|8|8", "")

End Sub

Private Sub Form_Unload(Cancel As Integer)
  SetToolBar ("0000X00X001X111")
End Sub


'设置TDBGRID的列头
Public Sub SetGridheader(ByVal strHeader As String, intNo As Integer, strColWidth As String, strFooter As String)
  On Error Resume Next
  Dim arrHeader() As String
  Dim arrFooter() As String
  Dim arrWidth() As String
  Dim i As Integer
  
  arrHeader = Split(strHeader, "|", -1, vbTextCompare)
  arrWidth = Split(strColWidth, "|", -1, vbTextCompare)
  arrFooter = Split(strFooter, "|", -1, vbTextCompare)
  
  tdbQuery(intNo).FooterForeColor = vbBlue
  
  For i = 0 To UBound(arrHeader)
     tdbQuery(intNo).Columns(i).Caption = arrHeader(i)
     tdbQuery(intNo).Columns(i).FooterText = arrFooter(i)
     Select Case UCase(Mid(tdbQuery(intNo).Columns(i).DataField, 1, 3))
       Case "CHR"
           tdbQuery(intNo).Columns(i).Alignment = dbgCenter
       Case "INT"
           tdbQuery(intNo).Columns(i).Alignment = dbgRight
           tdbQuery(intNo).Columns(i).NumberFormat = "#,##0"
           tdbQuery(intNo).Columns(i).ForeColor = vbBlue
       Case "DEC"
           tdbQuery(intNo).Columns(i).Alignment = dbgRight
           tdbQuery(intNo).Columns(i).NumberFormat = "#,##0.00"
           tdbQuery(intNo).Columns(i).ForeColor = vbRed
       Case "DAT"
           tdbQuery(intNo).Columns(i).Alignment = dbgCenter
           tdbQuery(intNo).Columns(i).NumberFormat = "yyyy-mm-dd"
           tdbQuery(intNo).Columns(i).ForeColor = vbBlue
       Case Else
     End Select

     '自定义宽度
     tdbQuery(intNo).Columns(i).Width = CInt(arrWidth(i) * 100)
  Next i
  
End Sub

Private Sub clearAll()          '清除所有可填数据的位置
    Dim i As Integer
    
    For i = 0 To txtFields.UBound
        Select Case i
          Case 0, 1, 2, 4, 5, 6
              txtFields(i).Text = ""
        End Select
    Next i
    
End Sub



Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        SendKeys "{TAB}"
        Exit Sub
    End If
End Sub