cw.frm

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

         EndProperty
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":BA0A
            Key             =   "Lockup"
         EndProperty
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":BD24
            Key             =   "X"
         EndProperty
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":C03E
            Key             =   "Help"
         EndProperty
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":C150
            Key             =   "People"
         EndProperty
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":DE5C
            Key             =   "Telephone"
         EndProperty
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":E178
            Key             =   "Phone"
         EndProperty
         BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":E494
            Key             =   "Adress"
         EndProperty
         BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "cw.frx":E7B0
            Key             =   "part"
         EndProperty
      EndProperty
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "销售财务状况表"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   300
      Left            =   3120
      TabIndex        =   4
      Top             =   480
      Width           =   2100
   End
   Begin VB.Label Label1 
      Caption         =   "财务：包括本年十二个月每月的合同签订金额、合同签订量、实收预付款、煤炭发运量、上期结存金额、本期结存金额"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   6120
      Width           =   6615
   End
   Begin VB.Menu filee 
      Caption         =   "文件"
      Begin VB.Menu topen 
         Caption         =   "打开"
      End
      Begin VB.Menu tsaver 
         Caption         =   "保存"
      End
      Begin VB.Menu tassaver 
         Caption         =   "另存为"
      End
      Begin VB.Menu tclose 
         Caption         =   "关闭"
      End
      Begin VB.Menu tnull1 
         Caption         =   "-"
      End
      Begin VB.Menu tprintset 
         Caption         =   "打印设置"
      End
      Begin VB.Menu tprint 
         Caption         =   "打印"
      End
      Begin VB.Menu tnull2 
         Caption         =   "-"
      End
      Begin VB.Menu tquit 
         Caption         =   "退出"
      End
   End
   Begin VB.Menu tpianji 
      Caption         =   "编辑"
      Begin VB.Menu topenpj 
         Caption         =   "打开编辑"
      End
      Begin VB.Menu tcopy 
         Caption         =   "复制"
         Enabled         =   0   'False
         Shortcut        =   ^C
      End
      Begin VB.Menu tvp 
         Caption         =   "粘贴"
         Enabled         =   0   'False
         Shortcut        =   ^V
      End
   End
End
Attribute VB_Name = "cw"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
Dim dATA1(12, 7) As Long
Dim thth(2000) As String
Dim mouth As Integer
Dim mm As Integer
Dim jj As Integer
Dim dd As Integer
Dim snfyl As Long '上年度结存量
Dim snxssr As Long '上年度结存金额

Dim benfyl As Long '本月发运量
Dim byxssr As Long '销售收入
mouth = Month(Me.DTPicker1.Value) '月份
Me.Label2.Caption = Format(Me.DTPicker1.Value, "yyyy") & "年度销售财务状况表"
Set rest = New ADODB.Recordset

rest.Open "select sum(wfl),sum(jcje) from htk where dj>0 and sj like '%" & Val(Format(Me.DTPicker1.Value, "yyyy")) - 1 & "%'", cn, adOpenStatic
''debug.Print "select sum(wfl),sum(jcje) from htk where dj>0 and sj like '%" & Val(Format(Me.DTPicker1.Value, "yyyy")) - 1 & "%'"
snfyl = rest.Fields(0) '上期发运结存量
snxssr = rest.Fields(1) ',上年度结存金额
''debug.Print snxssr
'逐月求各项指标
'本期结存金额=本期合同金额+上期结存金额-本期销售收入
'本期发运结存量=本期合同签订量+上期发运结存量-本期煤炭发运量
For mm = 1 To mouth - 1
 
  Set rest = New ADODB.Recordset
    rest.Open "select sum(htl),sum(je) from htk where dj>0 and sj like '%" & Format(Me.DTPicker1.Value, "yyyy") & "-" & month1(mm) & "%'", cn, adOpenStatic
    rest.MoveFirst
    dATA1(mm, 1) = rest.Fields(0) / 1000 '本期合同签订量
    dATA1(mm, 2) = rest.Fields(1) '本期合同金额
   '求本月使用的合同号
   Set rest = New ADODB.Recordset
   rest.Open "select DISTINCT  hth from jlk where  sj like '%" & Format(Me.DTPicker1.Value, "yyyy") & "-" & month1(mm) & "%'", cn, adOpenStatic
     rest.MoveFirst
   jj = rest.RecordCount
     For dd = 1 To jj
    If Not rest.Fields(0) Then
    thth(dd) = rest.Fields(0)
    End If
    rest.MoveNext
   Next dd
   '求本月发运量和销售收入
   For dd = 1 To jj
   Set rest = New ADODB.Recordset
   rest.Open "select sum(jlk.jz),(sum(jlk.jz)/1000)*htk.dj from htk,jlk where  jlk.hth='" & Trim(thth(dd)) & "' and htk.hth=jlk.hth group by htk.dj", cn, adOpenStatic
   benfyl = benfyl + rest.Fields(0) / 1000 '本月发运量
   byxssr = byxssr + rest.Fields(1) '本月销售收入
   Next dd '
   dATA1(mm, 3) = Fix(benfyl)  '本期发运量
    dATA1(mm, 6) = byxssr  '本期销售收入
 If mm > 1 Then
  dATA1(mm, 4) = dATA1(mm, 2) + dATA1(mm - 1, 4) - dATA1(mm, 6)
  dATA1(mm, 5) = dATA1(mm, 1) + dATA1(mm - 1, 5) - dATA1(mm, 3)
  Else
  dATA1(mm, 4) = dATA1(mm, 2) + snxssr - dATA1(mm, 6)
  dATA1(mm, 5) = dATA1(mm, 1) + benfyl - dATA1(mm, 3)
 
  
  End If
Next mm
For mm = 1 To mouth
Me.MSHFlexGrid1.Row = mm
For jj = 1 To 6
Me.MSHFlexGrid1.Col = jj
Me.MSHFlexGrid1.Text = dATA1(mm, jj)
Next jj
Next mm
End Sub

Private Sub Command2_Click()
 Set rest = New ADODB.Recordset
   rest.Open "select sum(htl)/1000,sum(je) from htk where dj>0 and sj like '%2003-06%'", cn, adOpenStatic
Set Me.MSHFlexGrid1.DataSource = rest
Me.MSHFlexGrid1.Refresh
End Sub

Private Sub Form_Load()
Dim ii As Integer
Dim jj As Integer
Me.MSHFlexGrid1.Col = 0
For ii = 1 To 12
Me.MSHFlexGrid1.Row = ii
Me.MSHFlexGrid1.Text = ii
Next ii
Me.MSHFlexGrid1.ColWidth(0) = 700
Me.MSHFlexGrid1.Col = 0
Me.MSHFlexGrid1.Row = 0
Me.MSHFlexGrid1.Text = "月  份"
Me.MSHFlexGrid1.Col = 1
Me.MSHFlexGrid1.Text = "本期合同签订量"
Me.MSHFlexGrid1.Col = 2
Me.MSHFlexGrid1.Text = "本期合同金额"
Me.MSHFlexGrid1.Col = 3
Me.MSHFlexGrid1.Text = "本期煤炭发运量"
Me.MSHFlexGrid1.Col = 4
Me.MSHFlexGrid1.Text = "本期结存金额"
Me.MSHFlexGrid1.Col = 5
Me.MSHFlexGrid1.Text = "本期发运结存量"
Me.MSHFlexGrid1.Col = 6
Me.MSHFlexGrid1.Text = "本期销售收入"
'Me.MSHFlexGrid1.Col = 1
'Me.MSHFlexGrid1.Text = "上期发运结存量"
'Me.MSHFlexGrid1.Col = 2
'Me.MSHFlexGrid1.Text = "上期结存金额"
For jj = 1 To 8
Me.MSHFlexGrid1.ColWidth(jj) = 1500
Next jj

'初始化时间
Me.DTPicker1.Value = Now

Set cn = New ADODB.Connection
cn.Open "dsn=dzqch"


'财务：包括本年十二个月每月的本期合同签订金额、
'本期合同签订量、本期实收预付款、本期煤炭发运量、上期结存金额、上期发运结存量
'本期结存金额

End Sub

Private Sub Form_Resize()
On Error Resume Next
Me.MSHFlexGrid1.Width = Me.ScaleWidth - Me.MSHFlexGrid1.Left * 2
End Sub

Private Sub MSHFlexGrid1_Click()
On Error Resume Next
If Me.topenpj = True Then
Me.Text1.Left = Me.MSHFlexGrid1.CellLeft + Me.MSHFlexGrid1.Left
Me.Text1.Top = Me.MSHFlexGrid1.CellTop + Me.MSHFlexGrid1.Top
Me.Text1.Width = Me.MSHFlexGrid1.CellWidth
Me.Text1.Height = Me.MSHFlexGrid1.CellHeight
Me.Text1.Font.Name = Me.MSHFlexGrid1.CellFontName
Me.Text1.Font.Size = Me.MSHFlexGrid1.CellFontSize
Me.Text1.Text = Me.MSHFlexGrid1.Text
Me.Text1.SetFocus
End If
'Me.Text1.Visible = True
End Sub

Private Sub MSHFlexGrid1_Scroll()
On Error Resume Next
Me.Text1.Left = Me.MSHFlexGrid1.CellLeft + Me.MSHFlexGrid1.Left
Me.Text1.Top = Me.MSHFlexGrid1.CellTop + Me.MSHFlexGrid1.Top
Me.Text1.Width = Me.MSHFlexGrid1.CellWidth
Me.Text1.Height = Me.MSHFlexGrid1.CellHeight
Me.Text1.Font.Name = Me.MSHFlexGrid1.CellFontName
Me.Text1.Font.Size = Me.MSHFlexGrid1.CellFontSize
End Sub

Private Sub Text1_Change()
 Me.MSHFlexGrid1.Text = Me.Text1.Text
End Sub

Private Sub tfont_Click()
Dim tfont As Boolean
tfont = CreateFont
'Me.CommonDialog1.ShowFont
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim response As Integer
       Select Case Button.Index
        Case 1
            
        Case 2
           
        Case 3
            
        Case 4
            
        Case 6
           ' Clipboard.SetText Me.RichTextBox1.SelText
            
        Case 7
            'Clipboard.SetText Me.RichTextBox1.SelText
        Case 8
            'Me.RichTextBox1.SelText = Clipboard.GetText
        Case 9
           ' Me.RichTextBox1.SelText = ""
        Case 11
           
        
        Case 13
            Me.MSHFlexGrid1.Font.Bold = Not Me.MSHFlexGrid1.Font.Bold
        Case 14
          Me.MSHFlexGrid1.Font.Italic = Not Me.MSHFlexGrid1.Font.Italic
       
        Case 15
         Me.MSHFlexGrid1.Font.Underline = Not Me.MSHFlexGrid1.Font.Underline
        Case 16
          Me.MSHFlexGrid1.Font.Strikethrough = Not Me.MSHFlexGrid1.Font.Strikethrough
        Case 21
         
        Case 22
            
        Case 24
         
        Case 25
         
        Case 26
             
        Case 28
             
        Case 29
             Unload Me
        Case 30
             
        Case 32
            
    End Select
End Sub
Private Sub topenpj_Click()
Me.topenpj.Checked = Not Me.topenpj.Checked
If Me.topenpj.Checked = True Then
Me.Text1.Visible = True
Me.tcopy.Enabled = True
Me.tvp.Enabled = True
Else
Me.Text1.Visible = False
Me.tcopy.Enabled = False
Me.tvp.Enabled = False

End If

MSHFlexGrid1_Click

End Sub