frmunsellpfquery.frm

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

FRM
745
字号
    
    For i = 0 To txtFields.UBound
        Select Case i
          Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13
              txtFields(i).Text = ""
        End Select
    Next i
    
'End Sub
      End If
             
      Frame1(0).Visible = False
    Case Else
  End Select
  Exit Sub
err:
  MsgBox "查询数据出错:" & err.Description, vbInformation
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 T1.ChrTuiShuNo, T2.ChrSellNo, T1.ChrBookNo, T1.ChrBookName,  T3.ChrBookType, T1.DecPrice,  abs(T1.IntAmount) as intAbsAmount, abs(T1.DecPrice*T1.intAmount) as decMoney," & _
                    "T1.DecSum, T2.ChrSellOperator, T2.DatSellDate, T2.ChrTSOperator, T2.DatTSDate FROM (TuiShuTable_List T1 LEFT JOIN TuiShuTable T2 ON T1.ChrTuiShuNo =T2.ChrTuiShuNo) LEFT JOIN BookData T3" & _
                    " ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo) " & strQuery(0) & " and ChrTSType='批发' order by T1.ChrTuiShuNo desc"
        Else
           sqlstring = "SELECT T1.ChrTuiShuNo, T2.ChrSellNo, T1.ChrBookNo, T1.ChrBookName, T3.ChrBookType, T1.DecPrice,  abs(T1.IntAmount) as intAbsAmount, abs(T1.DecPrice*T1.intAmount) as decMoney," & _
                    "T1.DecSum, T2.ChrSellOperator, T2.DatSellDate, T2.ChrTSOperator, T2.DatTSDate FROM (TuiShuTable_List T1 LEFT JOIN TuiShuTable T2 ON T1.ChrTuiShuNo =T2.ChrTuiShuNo) LEFT JOIN BookData T3" & _
                    " ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo) Where ChrTSType='批发' order by T1.ChrTuiShuNo 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|100|100;#,##0.00|100;#,##0|100;#,##0|100;#,##0.00|100|100|100|100" & _
                          " Header=退书单号|销售单号|书号|书名|图书类型|单价|数量|码洋|实洋|销售业务员|销售日期|退书业务员|退书日期" & _
                          " Subtotal=2\页总计\1\7\7\1\#,##0\2-1\1;1\总计\1\7\7\1\#,##0\2-1\2;" & _
                                   "2\页总计\1\8\8\1\#,##0.00\2-1\1;1\总计\1\8\8\1\#,##0.00\2-1\2;" & _
                                   "2\页总计\1\9\9\1\#,##0.00\2-1\1;1\总计\1\9\9\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
  
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 4 '供货商
        Call g_CommonSelect("   供货商编码   |    供货商名称   |   联系人  |  地址  ", "select chrClientNo,chrClientName,chrLinkman,chrAddress from ClientData where intFlag=0 and chrClientNo like '%" & txtFields(0).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(0).Text = arrQuery(0, 1)
        End If
    Case 5 '图书类型
        Call g_CommonSelect("  编号  |  图书类型  ", "select chrBookTypeNo,chrBookType from BookType where chrBookType like '%" & txtFields(1).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(1).Text = arrQuery(0, 1)
        End If
    Case 6 '书号
        Call g_CommonSelect("  书号  |  书名  |  单价  |  折扣  |  供货商  |  出版社  |  出版日期  ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
                               " from BookData where chrBookNo like '%" & txtFields(2).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(2).Text = arrQuery(0, 0)
              txtFields(3).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(3).Text & "%'", "0,1", , , , -1, arrQuery)
        If TypeName(arrQuery) = "Variant()" Then
              txtFields(2).Text = arrQuery(0, 0)
              txtFields(3).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
  
  dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
  dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
  
  Frame1(0).Visible = True
  
'  '单书明细
'  sqlstring = "SELECT T1.ChrTuiShuNo, T2.ChrSellNo, T1.ChrBookNo, T1.ChrBookName, T3.ChrBookType, T1.DecPrice,  abs(T1.IntAmount) as intAbsAmount, abs(T1.DecPrice*T1.intAmount) as decMoney," & _
'              "T1.DecSum, T2.ChrSellOperator, T2.DatSellDate, T2.ChrTSOperator, T2.DatTSDate FROM (TuiShuTable_List T1 LEFT JOIN TuiShuTable T2 ON T1.ChrTuiShuNo =T2.ChrTuiShuNo) LEFT JOIN BookData T3" & _
'              " ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo) where ChrTSType='批发'"
'  Set rstmp = New ADODB.Recordset
'  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
'  Set tdbQuery(0).DataSource = rstmp
'
'  sqlstring = "Select sum(intAbsAmount),sum(decMoney),sum(decSum) From (SELECT T1.ChrTuiShuNo, T2.ChrSellNo, T1.ChrBookNo, T1.ChrBookName, T3.ChrBookType, T1.DecPrice,  abs(T1.IntAmount) as intAbsAmount" & _
'              ", abs(T1.DecPrice*T1.intAmount) as decMoney,T1.DecSum, T2.ChrSellOperator, T2.DatSellDate, T2.ChrTSOperator, T2.DatTSDate FROM (TuiShuTable_List T1 LEFT JOIN TuiShuTable T2 ON T1.ChrTuiShuNo =T2.ChrTuiShuNo)" & _
'              " LEFT JOIN BookData T3 ON (T1.ChrBookName = T3.ChrBookName) AND (T1.ChrBookNo = T3.ChrBookNo) where ChrTSType='批发') T"
'  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, "12|12|12|25|12|7|10|12|12|10|10|10|10", strFoot)
'
'
  
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, 3, 4
              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

⌨️ 快捷键说明

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