menu31.frm

大学毕业的课题,可能比较简单一点,入门的人可以

refreshdata
Set ttab3 = bdkk.OpenRecordset("select * from tjb3 order by val(lsh)")
bgclear
intobg
ss = "select sum(val(zj)) as zja from tjb3 "
Set ttab3 = bdkk.OpenRecordset(ss)
a4 = ttab3("zja")
a4 = Format(a4, "0.00")
bg.AddItem ("" & vbTab & "净重统计" & vbTab & a4 & "t")
Command5.Enabled = True
End Sub


Private Sub Command12_Click()
Set ttab3 = bdkk.OpenRecordset("select * from tjb3 order by val(lsh)")
If ttab3.EOF Then
   MsgBox "无满足条件的记录！", vbExclamation + vbOKOnly, "查询系统"
   whotj = 0
   Exit Sub
End If

Dim ex As Object
Dim exwbook As Object
Dim exsheet As Object
 cmdlog.Filter = "EXCEL表文件(*.xls)|*.xls"
 'If whotj = 0 Then Exit Sub
cmdlog.ShowSave
filename1 = cmdlog.FileName
If Not Trim(filename1) = "" Then
Else
   MsgBox "无存储目标文件,不能输出,请重新进入!"
   Exit Sub
End If
 Text4.Visible = True
Dim i As Integer
Dim j As Integer
Set ex = CreateObject("Excel.Application")
    
Set exwbook = Nothing
Set exsheet = Nothing
Set exwbook = ex.Workbooks().Add
Set exsheet = exwbook.Worksheets("sheet1")
' ex.Range("c4:g7").Value = X

'Select Case whotj
'      Case 1
'         laon = "按地区统计: " + Combo2.Text
'      Case 2
'         laon = "按品种统计: " + Combo4.Text
'      Case 3
'         laon = "按含粉率统计: " + Combo1.Text
'      Case 4
'         laon = "按车号统计: " + Combo3.Text
'      Case 7
'         laon = "按货主统计: " + Text3.Text
 ''     Case 5
 '        laon = "全部统计 "
 '    Case 6
 '        laon = "按称重状态统计: " + Combo5
 '
'End Select
'ex.Range("a2").Value = laon
'Select Case whotj
'      Case 1
'         ss = " and dq='" + Combo2.Text + "' "
'      Case 2
'        ss = " and tdpz='" + Combo4.Text + "'   "
'      Case 3
''         ss = " and hflu='" + Combo1.Text + "'  "
'      Case 4
 ''        ss = " and ch='" + Combo3.Text + "' "
 '     Case 7
 '        ss = " and  hz='" + Text3.Text + "' "
 '     Case 5
 '       ss = ""
 '     Case 6
 '       Select Case Combo5.Text
          '  Case "未回皮"
          '     modi1 = 0
 '           Case "二次回皮"
 '              modi1 = "1"
 '           Case "特殊修改"
 '              modi1 = "2"
 '           Case "手工录入"
 '              modi1 = "3"
 '        End Select
 '        ss = " and  modi='" + modi1 + "' "
           
'End Select
'ss1 = " select * from gcd where len(zj)>0 And rq <= '" + Text2.Text + "' And rq >= '" + Text1.Text + "'  and modi<>'0'  and modi<>'6' " + ss + " order by val(lsh) "
'Set ttab3 = bdkk.OpenRecordset(ss1)
ex.range("a3").Value = "流水号"
ex.range("b3").Value = "地     区"
ex.range("c3").Value = "货   主"
ex.range("d3").Value = "车  型"
ex.range("e3").Value = "车     号"
ex.range("f3").Value = "物资名称"
ex.range("g3").Value = "毛  重(t)"
ex.range("h3").Value = "皮  重(t)"
ex.range("i3").Value = "净  重(t)"
ex.range("j3").Value = "司磅员"
ex.range("k3").Value = "称重状态"
ex.range("l3").Value = "司磅日期"
ex.range("m3").Value = "司磅时间"
ex.range("n3").Value = "备注"
Set myname = data1.OpenRecordset("table1")
me1 = myname("mainame") + "图书管理系统"

bbb = "    " + me1 + "分类汇总统计单"
ex.range("a1").Value = bbb
bbb = "  日期区间：" + Text1.Text + "至" + Text2.Text
ex.range("b2").Value = "统计方式"
ex.range("g2").Value = bbb
ex.range("c2").Value = whotj
i = 4
Do Until ttab3.EOF
   b1 = ttab3("lsh") & ""
   b2 = ttab3("hzdw") & ""
   b3 = ttab3("hzname") & ""
   b4 = ttab3("cx") & ""
   b5 = ttab3("ch") & ""
   b6 = ttab3("wzname") & ""
   b7 = Format$(ttab3("mz"), "0.00") & ""
   b8 = Format$(ttab3("pz"), "0.00") & ""
   b9 = Format$(ttab3("zj"), "0.00") & ""
   b10 = ttab3("sby") & ""
   If ttab3("modi") = 1 Then b11 = "二次回皮" Else If ttab3("modi") = 2 Then b11 = "特殊修改" Else b11 = "手工录入"
   b12 = ttab3("rq") & ""
   b13 = ttab3("ttime") & ""
   b14 = ttab3("bz") & ""
   ex.Cells(i, "a") = b1
   ex.Cells(i, "b") = b2
   ex.Cells(i, "c") = b3
   ex.Cells(i, "d") = b4
   ex.Cells(i, "e") = b5
   ex.Cells(i, "f") = b6
   ex.Cells(i, "g") = b7
   ex.Cells(i, "h") = b8
   ex.Cells(i, "i") = b9
   ex.Cells(i, "j") = b10
   ex.Cells(i, "k") = b11
   ex.Cells(i, "l") = b12
   ex.Cells(i, "m") = b13
   ex.Cells(i, "n") = b14
   i = i + 1
   ttab3.MoveNext
Loop


ss = "select sum(val(zj)) as zja from tjb3 "
Set ttab3 = bdkk.OpenRecordset(ss)
a4 = ttab3("zja")
a4 = Format(a4, "0.000")
'bg.AddItem ("统计" & vbTab & vbTab & vbTab & b4 & vbTab & a4)
   
   ex.Cells(i, "a") = "合   计"
   ex.Cells(i, "b") = a4 & "t"
   

    '保存输入到abc.xls
    exwbook.SaveAs filename1
    '退出excel
    ex.quit
    Text4.Visible = False
End Sub

Private Sub Command3_Click()
nf = LTrim(Str(Year(Date$)))
qsmonth = Month(Date$)
If Val(qsmonth) <= 9 Then
   year1 = nf + "-0" + LTrim$(RTrim$(Str$(qsmonth)))
Else
   year1 = nf + "-" + LTrim$(RTrim$(Str$(qsmonth)))
End If
Text1.Text = year1 + "-01"
Text2.Text = year1 + "-31"
End Sub

Private Sub Command4_Click()
whotj = "净重合计："
If Text1.Text = "" Or Text2.Text = "" Or Text2.Text < Text1.Text Then
   MsgBox "日期非法,请重新选择！", vbExclamation + vbOKOnly, "图书管理系统"
   Exit Sub
End If
bdkk.Execute "delete * from tjb3"
hz = Combo2.Text
Set ttab2 = bdkk.OpenRecordset("select * from gcd where len(zj)>0 And rq <= '" + Text2.Text + "' And rq >= '" + Text1.Text + "' and modi<>'0' ")
If ttab2.EOF Then
   MsgBox "无满足条件的记录！", vbExclamation + vbOKOnly, "图书管理系统"
   Exit Sub
End If

Set ttab3 = bdkk.OpenRecordset("tjb3")
refreshdata
Set ttab3 = bdkk.OpenRecordset("select * from tjb3 order by val(lsh)")
bgclear
intobg
ss = "select sum(val(zj)) as zja from tjb3 "
Set ttab3 = bdkk.OpenRecordset(ss)
a4 = ttab3("zja")
a4 = Format(a4, "0.00")
bg.AddItem ("" & vbTab & "净重统计" & vbTab & a4 & "t")
Command5.Enabled = True
End Sub

Private Sub Command5_Click()
Dim bbb As String
MsgBox "请准备好你的打印机，回车确定开始打印....", vbCritical + vbExclamation, "图书管理系统"
Printer.font.Bold = True
Printer.font.Size = 5
Printer.font = 10
Printer.DrawMode = 6
Printer.DrawWidth = 3
Printer.font.Bold = True
Set lstab = data1.OpenRecordset("table1")
bbb = lstab("mainame") + "统计单"
Dim s  As Integer
s = Len(bbb)
s = 200 + (10600 - 340 * s) / 2

a = prnt1(s, 350, 15, bbb)

bbb = "日期区间：" + Text1.Text + "至" + Text2.Text
a = prnt1(3500, 850, 11, bbb)
'Printer.Line (300, 1150)-(10990, 1150)
'Printer.Line (300, 1600)-(10990, 1600)
'a = prnt1(400, 1250, 13, "拉运单位        拉运人    品  种  车  号  净 重(t) ")
a = prnt1(100, 1250, 13, "流水号 日期      时间  拉运单位     拉运人    品  种  车  号  净重(t)  备注   ")

Set ttab3 = bdkk.OpenRecordset("tjb3")
i = 1600
Do Until ttab3.EOF
    If ttab3("lsh") = Empty Then b1 = " " Else b1 = ttab3("lsh")
    If ttab3("rq") = Empty Then b2 = " " Else b2 = ttab3("rq")
    If ttab3("ttime") = Empty Then b3 = " " Else b3 = ttab3("ttime")
    If ttab3("hzdw") = Empty Then b4 = " " Else b4 = ttab3("hzdw")
    If ttab3("hzname") = Empty Then b5 = " " Else b5 = ttab3("hzname")
    If ttab3("wzname") = Empty Then b6 = " " Else b6 = ttab3("wzname")
    If ttab3("ch") = Empty Then b7 = " " Else b7 = ttab3("ch")
    If ttab3("zj") = 0 Then b8 = " " Else b8 = ttab3("zj")
    If ttab3("bz") = Empty Then b9 = " " Else b9 = ttab3("bz")
'Set bdktab = bdkk.OpenRecordset("select * from tjb1 order by val(jyw),val(pinz)")
   a = prnt1(300, 100 + i, 12, b1 + "")
   a = prnt1(900, 100 + i, 12, b2 + "")
   a = prnt1(2200, 100 + i, 12, b3 + "")
   a = prnt1(2950, 100 + i, 12, b4 + "")
   a = prnt1(4850, 100 + i, 12, b5 + "")
   a = prnt1(6250, 100 + i, 12, b6 + "")
   a = prnt1(7400, 100 + i, 12, b7 + "")
   a = prnt1(8200, 100 + i, 12, b8 + "")
   a = prnt1(9400, 100 + i, 12, b9 + "")
   
   ttab3.MoveNext
   'Printer.Line (300, i + 500)-(10990, i + 500)
   i = i + 400
   If i >= Printer.ScaleHeight - 600 Then
      Printer.NewPage
      i = 0
      bpage = bpage + 1
   End If
Loop
ss = "select sum(val(zj)) as zja from tjb3 "
Set ttab3 = bdkk.OpenRecordset(ss)
a4 = ttab3("zja")
a4 = Format(a4, "0.00")
Printer.Line (300, i)-(10990, i)
a = prnt1(400, 100 + i, 12, " 统 计 数 据 ")
a = prnt1(2300, 100 + i, 11, "净重： " + a4 + "吨 ")
i = i + 400
Printer.EndDoc
End Sub

Private Sub Command6_Click()
nf = LTrim(Str(Year(Date$)))
qsdate = Day(Date$)
qsmonth = Month(Date$)
If Val(qsmonth) <= 9 Then
   year1 = nf + "-0" + LTrim$(RTrim$(Str$(qsmonth)))
Else
   year1 = nf + "-" + LTrim$(RTrim$(Str$(qsmonth)))
End If
If Val(qsdate) <= 9 Then
   year1 = year1 + "-0" + LTrim$(RTrim$(Str$(qsdate)))
Else
   year1 = year1 + "-" + LTrim$(RTrim$(Str$(qsdate)))
End If
Text1.Text = year1
Text2.Text = year1
End Sub

Private Sub Command7_Click()
Unload Me
End Sub

Private Sub Command8_Click()
nf = LTrim(Str(Year(Date$)))
Text1.Text = nf + "-01-01"
Text2.Text = nf + "-12-31"
End Sub

Private Sub Command9_Click()
whotj = "按拉运单位统计："
If Text1.Text = "" Or Text2.Text = "" Or Text2.Text < Text1.Text Then
   MsgBox "日期非法,请重新选择！", vbExclamation + vbOKOnly, "图书管理系统"
   Exit Sub
End If
bdkk.Execute "delete * from tjb3"
hz = Combo2.Text

Set ttab2 = bdkk.OpenRecordset("select * from gcd where len(zj)>0 And rq <= '" + Text2.Text + "' And rq >= '" + Text1.Text + "' and hzdw='" + Combo2.Text + "'  and modi<>'0' ")
If ttab2.EOF Then
   MsgBox "无满足条件的记录！", vbExclamation + vbOKOnly, "图书管理系统"
   Exit Sub
End If

Set ttab3 = bdkk.OpenRecordset("tjb3")
refreshdata
Set ttab3 = bdkk.OpenRecordset("select * from tjb3 order by val(lsh)")
bgclear
intobg
ss = "select sum(val(zj)) as zja from tjb3 "
Set ttab3 = bdkk.OpenRecordset(ss)
a4 = ttab3("zja")
a4 = Format(a4, "0.00")
bg.AddItem ("" & vbTab & "净重统计统计" & vbTab & a4 & "t")
Command5.Enabled = True
End Sub

Private Sub Form_Load()
Set bdkk = OpenDatabase(App.Path + "\bdk.mdb")
Set bdktab = bdkk.OpenRecordset("gcd")
changebj = 0

selectdate.Left = 2360
selectdate.Top = 2560

Set jcktab = data1.OpenRecordset("wzk")
Set bdktab = bdkk.OpenRecordset("select * from gcd ")
selectdate.Value = Date$
selectdate.Refresh
Set pztab = data1.OpenRecordset("wzk")
Set hztab = data1.OpenRecordset("dqk")
Combo1.Clear
Do Until pztab.EOF
   Combo1.AddItem pztab("wzname")
   pztab.MoveNext
Loop
If Combo1.ListCount >= 1 Then Combo1.ListIndex = 0
Combo2.Clear
Do Until hztab.EOF
   Combo2.AddItem hztab("dq")
   hztab.MoveNext
Loop
If Combo2.ListCount >= 1 Then Combo2.ListIndex = 0

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
mainboot.menunum = "nothing"
mainboot.Picture1.Visible = True
End Sub

Private Sub Form_Resize()
winmenu31.Left = 0
winmenu31.Top = 0
winmenu31.Width = 12120 - 190 '9540
winmenu31.Height = 8700 - 750 '6144
bg.Left = 0
bg.Top = 1820
bg.Width = Me.ScaleWidth

bg.Height = Me.Height - 1180 - 700
Command5.Enabled = False
End Sub

Private Sub Image3_Click()
selectdate.Visible = True
whattodo = "qsrq"
Image3.Enabled = False
Image4.Enabled = False

End Sub

Private Sub Image4_Click()
selectdate.Visible = True
whattodo = "zzrq"
Image3.Enabled = False
Image4.Enabled = False

End Sub

Private Sub selectdate_DateClick(ByVal DateClicked As Date)
nf = LTrim(Str(Year(selectdate.Value)))
Select Case whattodo
  Case "qsrq"
   qsdate = Day(selectdate.Value)
   qsmonth = Month(selectdate.Value)
   If Val(qsmonth) <= 9 Then
      year1 = nf + "-0" + LTrim$(RTrim$(Str$(qsmonth)))
   Else
      year1 = nf + "-" + LTrim$(RTrim$(Str$(qsmonth)))
   End If
   If Val(qsdate) <= 9 Then
      year1 = year1 + "-0" + LTrim$(RTrim$(Str$(qsdate)))
   Else
      year1 = year1 + "-" + LTrim$(RTrim$(Str$(qsdate)))
   End If
   Text1.Text = year1
  Case "zzrq"
   qsdate = Day(selectdate.Value)
   qsmonth = Month(selectdate.Value)
   If Val(qsmonth) <= 9 Then
      year1 = nf + "-0" + LTrim$(RTrim$(Str$(qsmonth)))
   Else
      year1 = nf + "-" + LTrim$(RTrim$(Str$(qsmonth)))
   End If
   If Val(qsdate) <= 9 Then
      year1 = year1 + "-0" + LTrim$(RTrim$(Str$(qsdate)))
   Else
      year1 = year1 + "-" + LTrim$(RTrim$(Str$(qsdate)))
   End If
   Text2.Text = year1
End Select
selectdate.Visible = False
Image3.Enabled = True
Image4.Enabled = True
End Sub