frmckquery.frm
来自「通用书店管理系统」· FRM 代码 · 共 1,357 行 · 第 1/4 页
FRM
1,357 行
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
Select Case SSTab1.Caption
Case "明细"
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"
sqlstring = "SELECT T1.ChrCKDH, T1.ChrBookNo, T1.ChrBookName, T3.ChrOutStorageName, T2.ChrStorageNo1, T2.ChrStorageNo2, T1.DecPrice, T1.DecAgio, " & _
" T1.IntAmount,T1.IntAmount*T1.decPrice as decMoney,T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney FROM (OutstorageInformation_List T1 " & _
" LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) LEFT JOIN OutStorageType T3 ON T2.ChrOutStorageNo = T3.ChrOutStorageNo " & strQuery(0) & " order by T1.ChrCKDH desc"
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|100;#,##0.00|100;#,##0.00|100;#,##0|100;#,##0.00|100;#,##0.00" & _
" Header=出库单号|书号|书名|出库类型|出库区号|入库区号|单价|折扣|数量|码洋|实洋" & _
" Subtotal=2\页总计\1\9\9\1\#,##0\1-0\1;1\总计\1\9\9\1\#,##0\1-0\2;" & _
"2\页总计\1\10\10\1\#,##0.00\1-0\1;1\总计\1\10\10\1\#,##0.00\1-0\2;" & _
"2\页总计\1\11\11\1\#,##0.00\1-0\1;1\总计\1\11\11\1\#,##0\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
Case "汇总"
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"
sqlstring = "SELECT count(chrBookNo),chrBookNo,chrBookName,sum(intAmount) as intTotal,sum(decMoney) as decTotalMoney," & _
"sum(decFactMoney) as decTotalFactMoney From (SELECT T1.ChrBookNo, T1.ChrBookName,T1.IntAmount," & _
"T1.IntAmount*T1.decPrice as decMoney,T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney " & _
" FROM (OutstorageInformation_List T1 LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) " & _
strQuery(1) & " )A Group by chrBookNo,chrBookName"
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" & _
" 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;" & _
' "2\页总计\1\6\6\1\#,##0.00\1-0\1;1\总计\1\6\6\1\#,##0\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
End Select
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 1
Frame1(1).Visible = True
Case 2
Call g_CommonSelect(" 出库类型编号 | 出库类型 ", "select chrOutStorageNo,chrOutStorageName from OutStorageType ", "0,1", , , , -1, arrQuery)
If TypeName(arrQuery) = "Variant()" Then
txtFields(0).Text = arrQuery(0, 0)
End If
Case 3
Call g_CommonSelect(" 书号 | 书名 | 单价 | 折扣 | 供货商 | 出版社 | 出版日期 ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
" from BookData where chrBookNo like '%" & txtFields(1).Text & "%'", "0,1", , , , -1, arrQuery)
If TypeName(arrQuery) = "Variant()" Then
txtFields(1).Text = arrQuery(0, 0)
' txtFields(2).Text = arrQuery(0, 1)
End If
Case 4
Call g_CommonSelect(" 书号 | 书名 | 单价 | 折扣 | 供货商 | 出版社 | 出版日期 ", "select chrBookNo,chrBookName,DecPrice,DecAgio,ChrGHS,Chrbookconcern,DatPublishDate" & _
" from BookData where chrBookName like '%" & txtFields(2).Text & "%'", "0,1", , , , -1, arrQuery)
If TypeName(arrQuery) = "Variant()" Then
' txtFields(1).Text = arrQuery(0, 0)
txtFields(2).Text = arrQuery(0, 1)
End If
Case 5
Call g_CommonSelect(" 出库类型编号 | 出库类型 ", "select chrOutStorageNo,chrOutStorageName from OutStorageType ", "0,1", , , , -1, arrQuery)
If TypeName(arrQuery) = "Variant()" Then
txtFields(4).Text = arrQuery(0, 0)
End If
Case 6
' Call g_CommonSelect(" 出库单号 ", "select chrCKDH from OutstorageInformation_list where chrCKDH like '%" & txtFields(6).Text & "%'", "0", , , , -1, arrQuery)
' If TypeName(arrQuery) = "Variant()" Then
' txtFields(6).Text = arrQuery(0, 0)
'
' 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(5).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
dtpDate(0).Value = Format(Date, "yyyy-mm-dd")
dtpDate(1).Value = Format(Date, "yyyy-mm-dd")
dtpDate(2).Value = Format(Date, "yyyy-mm-dd")
dtpDate(3).Value = Format(Date, "yyyy-mm-dd")
Frame1(0).Visible = True
Frame1(1).Visible = True
' '明细
' sqlstring = "SELECT T1.ChrCKDH, T1.ChrBookNo, T1.ChrBookName, T3.ChrOutStorageName, T2.ChrStorageNo1, T2.ChrStorageNo2, T1.DecPrice, T1.DecAgio, " & _
' " T1.IntAmount,T1.IntAmount*T1.decPrice as decMoney,T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney FROM (OutstorageInformation_List T1 " & _
' " LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) LEFT JOIN OutStorageType T3 ON T2.ChrOutStorageNo = T3.ChrOutStorageNo"
' Set rstmp = New ADODB.Recordset
' rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
' Set tdbQuery(0).DataSource = rstmp
'
' sqlstring = "SELECT sum(T1.IntAmount),sum(T1.IntAmount*T1.decPrice),sum(T1.IntAmount*T1.decPrice*T1.decAgio) FROM (OutstorageInformation_List T1 " & _
' " LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) LEFT JOIN OutStorageType T3 ON T2.ChrOutStorageNo = T3.ChrOutStorageNo"
' 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, "20|15|25|10|10|10|10|8|15|15|15", strFoot)
'
' '汇总
' sqlstring = "SELECT count(chrBookNo),chrBookNo,chrBookName,sum(intAmount) as intTotal,sum(decMoney) as decTotalMoney," & _
' "sum(decFactMoney) as decTotalFactMoney From (SELECT T1.ChrBookNo, T1.ChrBookName,T1.IntAmount," & _
' "T1.IntAmount*T1.decPrice as decMoney,T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney " & _
' " FROM (OutstorageInformation_List T1 LEFT JOIN OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) )A" & _
' " Group by chrBookNo,chrBookName"
' Set rstmp = New ADODB.Recordset
' rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
' Set tdbQuery(1).DataSource = rstmp
'
' sqlstring = "Select sum(intTotal),sum(decTotalMoney),sum(decTotalFactMoney) From (SELECT count(chrBookNo),chrBookNo," & _
' " chrBookName,sum(intAmount) as intTotal,sum(decMoney) as decTotalMoney,sum(decFactMoney) as decTotalFactMoney " & _
' " From (SELECT T1.ChrBookNo, T1.ChrBookName,T1.IntAmount,T1.IntAmount*T1.decPrice as decMoney," & _
' " T1.IntAmount*T1.decPrice*T1.decAgio as decFactMoney FROM (OutstorageInformation_List T1 LEFT JOIN " & _
' " OutstorageInformation T2 ON T1.ChrCKDH = T2.ChrCKDH) )A Group by chrBookNo,chrBookName)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("笔数|书号|书名|数量|码洋|实洋", 1, "8|15|25|15|15|15", 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, 5
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 + -
显示快捷键?