form3.frm

煤炭销售管理系统.完成煤炭销售的日常管理工作,和重车计量系统空车计量系统配合使用.

End If

End Sub

Private Sub Command4_Click()
On Error Resume Next
Me.List1.RemoveItem Me.List1.ListIndex
End Sub

Private Sub Command5_Click()
If Me.Option1 = True Then
Me.Combo3.Enabled = True
sqlstr = "fhr='" & Trim(Me.Combo1.Text) & "'"

sqlstr = sqlstr & "  and  wfl" & Trim(Me.Combo3.Text) & Val(Me.Text1.Text) & "and hwm like '%" & Trim(Me.Combo4.Text) & "%'"
Me.DataGrid1.Caption = Combo1.Text & "合同发运情况"
End If
If Me.Option2 = True Then
sqlstr = "fhdw='" & Trim(Me.Combo2.Text) & "'"
sqlstr = sqlstr & "  and  wfl" & Trim(Me.Combo3.Text) & Val(Me.Text1.Text) & "and hwm like '%" & Trim(Me.Combo4.Text) & "%'"
Me.DataGrid1.Caption = Combo2.Text & "合同发运情况"
End If

Me.Adodc1.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where  " & sqlstr
Adodc1.refresh
''debug.Print Me.Adodc1.RecordSource
Me.Command6.Enabled = True
Me.Command1.Enabled = True
Me.Command2.Enabled = True
Me.Command3.Enabled = True
Me.Command4.Enabled = True
End Sub

Private Sub Command6_Click()
Dim list1recc As Integer
Dim restrecc As Integer
Dim ljwfl As Long
Dim ljje As Long
list1recc = Me.List1.listcount
Dim ff As Integer
Dim ii As Integer
ljwfl = 0
If Val(Text2.Text) = 0 Then Exit Sub
   Me.Adodc2.RecordSource = "select * from htk where hth ='" & Trim(Text2.Text) & "'"
   Me.Adodc2.refresh

If Me.Adodc2.Recordset.RecordCount > 1 Then
MsgBox "该票号已存在，请重输!", vbDefaultButton1
Exit Sub
Else
   
   '清除MSHFlexGrid1
   
   Me.MSHFlexGrid1.Clear
'求字段个数
Me.Adodc2.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk "
   Me.Adodc2.refresh
  restrecc = Me.Adodc2.Recordset.Fields.Count
  '确定MSHFlexGrid1的列数
  Me.MSHFlexGrid1.Cols = restrecc
  '添列表头
Me.MSHFlexGrid1.Row = 0
Me.MSHFlexGrid1.Col = 0
Me.MSHFlexGrid1.Text = "项   目"

For ii = 1 To restrecc - 1
        Me.MSHFlexGrid1.Col = (ii)
       Me.MSHFlexGrid1.Text = Me.Adodc2.Recordset.Fields(ii - 1).Name
       'Me.MSHFlexGrid1.ColWidth(ii) = Me.Adodc2.Recordset.Fields(ii).ActualSize
       
   Next ii
   '求表行数
    Me.MSHFlexGrid1.Rows = Me.List1.listcount + 5
    '向表格天数据

Me.MSHFlexGrid1.Row = 1
 Me.MSHFlexGrid1.Col = 0
  Me.MSHFlexGrid1.Text = "调整前的数据："
For ff = 0 To Me.List1.listcount - 1
   '根据List1中的值，----------------
               Me.Adodc2.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where hth='" & Trim(Me.List1.List(ff)) & "'"
              Me.Adodc2.refresh
              Me.Adodc2.Recordset.MoveFirst
   
    '求累计尾量
            ljwfl = ljwfl + Me.Adodc2.Recordset.Fields(3)
            ljje = ljje + ((Me.Adodc2.Recordset.Fields(3) / 100) * Me.Adodc2.Recordset.Fields(7))
           Me.MSHFlexGrid1.Row = ff + 2
   '填数据
   For ii = 1 To restrecc - 1
       'Form2.Picture1.CurrentX = ii * Me.Adodc2.Recordset.Fields(ii).ActualSize + 8
         Me.MSHFlexGrid1.Col = (ii)
         Me.MSHFlexGrid1.Text = Me.Adodc2.Recordset.Fields(ii - 1)
   Next ii
         Me.MSHFlexGrid1.Col = 0
         Me.MSHFlexGrid1.Text = ff + 1
    '更新数据库
        Me.Adodc2.Recordset.Fields(2) = Me.Adodc2.Recordset.Fields(1) '已发量等合同量
        Me.Adodc2.Recordset.Fields(3) = 0 '未发量为0
   
   
   
  Next ff
       Me.MSHFlexGrid1.Row = ff + 2
       Me.MSHFlexGrid1.Col = 0
       Me.MSHFlexGrid1.Text = "调整后数据："
        Me.MSHFlexGrid1.Row = ff + 3
       Me.MSHFlexGrid1.Col = 1
       Me.MSHFlexGrid1.Text = Text2.Text
       Me.MSHFlexGrid1.Col = 2
       Me.MSHFlexGrid1.Text = ljwfl
       Me.MSHFlexGrid1.Col = 3
       Me.MSHFlexGrid1.Text = 0
       Me.MSHFlexGrid1.Col = 4
       Me.MSHFlexGrid1.Text = ljwfl
       Me.MSHFlexGrid1.Col = 5
       Me.MSHFlexGrid1.Text = Me.Adodc2.Recordset.Fields(4)
       Me.MSHFlexGrid1.Col = 6
       Me.MSHFlexGrid1.Text = Me.Adodc2.Recordset.Fields(5)
       Me.MSHFlexGrid1.Col = 7
       Me.MSHFlexGrid1.Text = Me.Adodc2.Recordset.Fields(6)
       Me.MSHFlexGrid1.Col = 8
  'Me.MSHFlexGrid1.text = Me.Adodc2.Recordset.Fields(7)
       Me.MSHFlexGrid1.Col = 9
       Me.MSHFlexGrid1.Text = ljje
       Me.MSHFlexGrid1.Col = 10
       Me.MSHFlexGrid1.Text = Format(Now, "yyyy-mm-dd")
       Me.MSHFlexGrid1.Col = 11
       Me.MSHFlexGrid1.Text = Me.Adodc2.Recordset.Fields(10)
  End If
  Dim dd As Integer
  dd = MsgBox("发运尾量已经调整，确认保存结果吗？", 36)
  If dd = 6 Then
  'Me.MSHFlexGrid1.Row = ff + 3
    Me.Adodc2.Recordset.AddNew
    For ff = 1 To 11
          
      
      Me.MSHFlexGrid1.Col = ff
     Select Case ff
     Case 1
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
      Case 2
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 3
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 4
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 5
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 6
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 7
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 8
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
    
       Case 9
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 10
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
     Case 11
      Me.Adodc2.Recordset.Fields(ff - 1) = Me.MSHFlexGrid1.Text
    
      
      
      End Select
      
       
       
        Next ff
      Me.Adodc2.Recordset.UpdateBatch adAffectAllChapters
  For ff = 0 To Me.List1.listcount - 1
        Me.Adodc2.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where hth='" & Trim(Me.List1.List(ff)) & "'"
        Me.Adodc2.refresh
        Me.Adodc2.Recordset.MoveFirst
        Me.Adodc2.Recordset.Fields(2) = Me.Adodc2.Recordset.Fields(1) '已发量等合同量
        Me.Adodc2.Recordset.Fields(3) = 0 '未发量为0
        Me.Adodc2.Recordset.UpdateBatch adAffectAllChapters
  Next ff
    
  End If
  End Sub

Private Sub Command7_Click()
CurtPrinter1.Visible = True
PrintContent
End Sub
Public Sub PrintContent(Optional PrintDevice As Printer)
On Error Resume Next
    Const TableStartX = 10
        If PrintDevice Is Nothing Then
        CurtPrinter1.StartPrint toPreview '预览
    Else
        CurtPrinter1.StartPrint toPrinter '打印到打印机
    End If
    Dim strr
    With CurtPrinter1
       
    '重新开始一页，直接打印报表，注意，它会自动换页，如果你设定了标题，它也自动打哦:)
    .NewPage
    
    '直接打印MSHFlexGrid
   
     .TitleOut "崔庄煤矿发运尾量调整单", 20, vbCenter
     .FontSize = 14
    .CurrentY = 25
     .TextOut "管理单位（章）："
      .CurrentY = 40
     .TextOut "发货人（发货单位）："
      .CurrentY = 60
     .TextOut "尾  量  调  整  人："
      .CurrentY = 80
    .TextOutEx Me.Text3.Text
    .NewCellRow
    .DirectPrint MSHFlexGrid1, "尾量调整记录"
    
     .EndDoc
    End With

End Sub

Private Sub Form_Load()
Dim recc As Long
recc = 0
Adodc1.ConnectionString = connetstr
Adodc1.RecordSource = "select hth as 票号,htl as  合同量,yfl as 已发量,wfl as 欠存量,hwm as 货物名,fhr as 发货人,fhdw as 发货单位,dj as 单价,je as 金额,sj as 发货时间,ysfs as 运输方式,jsfs as 结算方式,bz as 备注 from htk  where wfl>0"

Me.Adodc2.ConnectionString = connetstr
Me.Adodc2.RecordSource = "select DISTINCT fhr from htk where wfl>0"
Adodc2.refresh

recc = Adodc2.Recordset.RecordCount
Dim ii%
For ii% = 1 To recc
If IsNull(Adodc2.Recordset.Fields(0)) = False Then
Me.Combo1.AddItem Adodc2.Recordset.Fields(0)
End If
Adodc2.Recordset.MoveNext
20:
Next ii%


recc = 0
Me.Adodc2.ConnectionString = connetstr
Me.Adodc2.RecordSource = "select DISTINCT fhdw from htk where wfl>0"
Adodc2.refresh

recc = Adodc2.Recordset.RecordCount

For ii% = 1 To recc
If IsNull(Adodc2.Recordset.Fields(0)) = False Then
Me.Combo2.AddItem Adodc2.Recordset.Fields(0)

End If
Adodc2.Recordset.MoveNext
Next ii%
    Me.Adodc2.RecordSource = "select DISTINCT hwm from htk where wfl>0"
    Adodc2.refresh
    recc = Adodc2.Recordset.RecordCount

For ii% = 1 To recc
If IsNull(Adodc2.Recordset.Fields(0)) = False Then
    Me.Combo4.AddItem Adodc2.Recordset.Fields(0)
End If
Adodc2.Recordset.MoveNext
Next ii%

End Sub

Private Sub CloneFont(Dest As StdFont, Src As StdFont)
    With Dest
    .Bold = Src.Bold
    .Charset = Src.Charset
    .Italic = Src.Italic
    .Name = Src.Name
    .Size = Src.Size
    .Strikethrough = Src.Strikethrough
    .Underline = Src.Underline
    .Weight = Src.Weight
    End With
End Sub
    
Private Sub curtprinter1_ClosePreview()
    CurtPrinter1.Visible = False
    'mnuManual.Enabled = False
End Sub
    '如果每次调整预览比例好重新生成预览的话，请将AutoRedraw设置为FALSE，然后在下面的事件添入要重画的代码
    '##################################################################
    '## 过程名称：curtprinter1_NeedRedraw
    '## 参数： 无
    '##################################################################
'##################################################################
'## 过程名称：curtprinter1_NeedRedraw
'## 参数： 无
'##################################################################
Private Sub CurtPrinter1_NeedRedraw()
    PrintContent
End Sub
    '写入打印叶脚的代码
    '##################################################################
    '## 过程名称：CurtPrinter1_PrintFooter
    '## 参数：CurrentPage 为Long型
    '## 参数：LeftText 为String型
    '## 参数：CenterText 为String型
    '## 参数：RightText 为String型
    '##################################################################
'##################################################################
'## 过程名称：CurtPrinter1_PrintFooter
'## 参数：CurrentPage 为Long型
'## 参数：LeftText 为String型
'## 参数：CenterText 为String型
'## 参数：RightText 为String型
'##################################################################
Private Sub CurtPrinter1_PrintFooter(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
    ''LeftText = jl_zgdw
    CenterText = Format(Now, "yyyy年m月d日")
    RightText = "其他信息"
End Sub
    
    '写入打印页眉的代码
    '##################################################################
    '## 过程名称：CurtPrinter1_PrintHeader
    '## 参数：CurrentPage 为Long型
    '## 参数：LeftText 为String型
    '## 参数：CenterText 为String型
    '## 参数：RightText 为String型
Private Sub CurtPrinter1_PrintHeader(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
    LeftText = Date
    CenterText = jl_qym
    RightText = "这是第 " & CurrentPage & " 页"
End Sub
    
    '点击了预览窗体或直接调用ShowPrinter后，点击了打印机窗口的确定，引发打印代码，打印到打印机上！
    '##################################################################
    '## 过程名称：curtprinter1_RealPrint
    '## 参数： 无
Private Sub curtprinter1_RealPrint()
    PrintContent Printer
End Sub
    '如果隐藏工具条，仍可以通过简单的编程控制预览
    '###############################
Private Sub Form_Resize()
Me.CurtPrinter1.Move 0, 0, Me.Width, Me.Height - 400
End Sub