frmcgehetong.frm

本系统是北京神兵广告有限公司的广告系统

   Begin VB.Label Label21 
      Caption         =   "（元）"
      Height          =   255
      Left            =   7920
      TabIndex        =   24
      Top             =   2040
      Width           =   615
   End
   Begin VB.Label Label22 
      Caption         =   "（元）"
      Height          =   255
      Left            =   3480
      TabIndex        =   23
      Top             =   2520
      Width           =   615
   End
   Begin VB.Label Label23 
      Caption         =   "（元）"
      Height          =   255
      Left            =   7800
      TabIndex        =   22
      Top             =   2520
      Width           =   615
   End
   Begin VB.Label Label24 
      Caption         =   "（元）"
      Height          =   255
      Left            =   3480
      TabIndex        =   21
      Top             =   3000
      Width           =   615
   End
   Begin VB.Label Label25 
      Caption         =   "（元）"
      Height          =   255
      Left            =   7920
      TabIndex        =   20
      Top             =   3000
      Width           =   615
   End
   Begin VB.Label Label26 
      Caption         =   "（元）"
      Height          =   255
      Left            =   3480
      TabIndex        =   19
      Top             =   3480
      Width           =   615
   End
   Begin VB.Label Label27 
      Caption         =   "（元）"
      Height          =   255
      Left            =   7800
      TabIndex        =   18
      Top             =   3480
      Width           =   615
   End
   Begin VB.Label Label28 
      Caption         =   " 备 注："
      Height          =   255
      Left            =   960
      TabIndex        =   17
      Top             =   4920
      Width           =   855
   End
End
Attribute VB_Name = "frmcgehetong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub Combo1_Click()
Command1.Enabled = True
Dim sql As String
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs As ADODB.Recordset
Set rs = New Recordset
sql = "select * from hetong where hetong_no='" & Combo1.Text & "'"
rs.Open sql, con, 1, 1
If Not rs.EOF Then

Text2.Text = rs!xgxy_no
Text3.Text = rs(3).Value
Text4.Text = rs(4).Value
Text5.Text = rs(5).Value
Text6.Text = rs(6).Value
Text7.Text = rs(7).Value
Text8.Text = rs(8).Value
Text9.Text = rs(9).Value
Text10.Text = rs(10).Value
Text11.Text = rs(11).Value
Text12.Text = rs(12).Value
Text13.Text = rs(13).Value
Text14.Text = rs(14).Value
month1 = Month(rs(15).Value)
If Len(month1) = 1 Then month1 = "0" & month1
Day1 = Day(rs(15).Value)
If Len(Day1) = 1 Then Day1 = "0" & Day1

Text15.Text = Year(rs(15).Value) & "年" & month1 & "月" & Day1 & "日"
month1 = Month(rs(16).Value)

If Len(month1) = 1 Then month1 = "0" & month1
Day1 = Day(rs(16).Value)
If Len(Day1) = 1 Then Day1 = "0" & Day1
Text16.Text = Year(rs(16).Value) & "年" & month1 & "月" & Day1 & "日"
month1 = Month(rs(17).Value)
If Len(month1) = 1 Then month1 = "0" & month1
Day1 = Day(rs(17).Value)
If Len(Day1) = 1 Then Day1 = "0" & Day1
Text17.Text = Year(rs(17).Value) & "年" & month1 & "月" & Day1 & "日"
Text18.Text = rs(18).Value
If IsNull(rs(19).Value) = False Then
Text19.Text = rs(19).Value
Else
Text19.Text = ""
End If
Text20.Text = rs!id


Else
msg = MsgBox("当前没有任何合同信息", 16, "错误")
Unload Me
frmmain.Show
Exit Sub
End If



rs.Close
End Sub

Private Sub Command1_Click()
If Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Or Text10.Text = "" Or Text11.Text = "" Or Text12.Text = "" Or Text13.Text = "" Or Text14.Text = "" Or Text15.Text = "" Or Text16.Text = "" Or Text17.Text = "" Or Text18.Text = "" Or Text20.Text = "" Then
msg = MsgBox("字段不完整", 16, "错误")
Combo1.SetFocus
Exit Sub
End If
If IsNumeric(Text5.Text) = False Then
msg = MsgBox("投放次数必须是数字", 16, "错误")
Text5.SetFocus
Exit Sub
End If
If IsNumeric(Text7.Text) = False Then
msg = MsgBox("刊列金额必须是数字", 16, "错误")
Text7.SetFocus
Exit Sub
End If
If IsNumeric(Text8.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text8.SetFocus
Exit Sub
End If
If IsNumeric(Text9.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text9.SetFocus
Exit Sub
End If
If IsNumeric(Text10.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text10.SetFocus
Exit Sub
End If
If IsNumeric(Text11.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text11.SetFocus
Exit Sub
End If
If IsNumeric(Text12.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text12.SetFocus
Exit Sub
End If
If IsNumeric(Text13.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text13.SetFocus
Exit Sub
End If
If IsNumeric(Text14.Text) = False Then
msg = MsgBox("金额必须是数字", 16, "错误")
Text14.SetFocus
Exit Sub
End If
If IsNumeric(Left(Text15.Text, 4)) = False Then
msg = MsgBox("年份必须是4位数字", 16, "错误")
Text15.SetFocus
Exit Sub
End If
If IsNumeric(Left(Text16.Text, 4)) = False Then
msg = MsgBox("年份必须是4位数字", 16, "错误")
Text16.SetFocus
Exit Sub
End If
If IsNumeric(Left(Text17.Text, 4)) = False Then
msg = MsgBox("年份必须是4位数字", 16, "错误")
Text17.SetFocus
Exit Sub
End If
If IsNumeric(Mid(Text15.Text, 6, 2)) = False Then
msg = MsgBox("月份必须是2位数字", 16, "错误")
Text15.SetFocus
Exit Sub
End If
If IsNumeric(Mid(Text16.Text, 6, 2)) = False Then
msg = MsgBox("月份必须是2位数字", 16, "错误")
Text16.SetFocus
Exit Sub
End If
If IsNumeric(Mid(Text17.Text, 6, 2)) = False Then
msg = MsgBox("月份必须是2位数字", 16, "错误")
Text17.SetFocus
Exit Sub
End If
If IsNumeric(Mid(Text15.Text, 9, 2)) = False Then
msg = MsgBox("日必须是2位数字", 16, "错误")
Text15.SetFocus
Exit Sub
End If
If IsNumeric(Mid(Text16.Text, 9, 2)) = False Then
msg = MsgBox("日必须是2位数字", 16, "错误")
Text16.SetFocus
Exit Sub
End If
If IsNumeric(Mid(Text17.Text, 9, 2)) = False Then
msg = MsgBox("日必须是2位数字", 16, "错误")
Text17.SetFocus
Exit Sub
End If
If Mid(Text15.Text, 6, 2) > 12 Or Mid(Text15.Text, 6, 2) < 1 Then
msg = MsgBox("月份不正确", 16, "错误")
Text15.SetFocus
Exit Sub
End If
If Mid(Text16.Text, 6, 2) > 12 Or Mid(Text16.Text, 6, 2) < 1 Then
msg = MsgBox("月份不正确", 16, "错误")
Text16.SetFocus
Exit Sub
End If
If Mid(Text17.Text, 6, 2) > 12 Or Mid(Text17.Text, 6, 2) < 1 Then
msg = MsgBox("月份不正确", 16, "错误")
Text17.SetFocus
Exit Sub
End If
If Mid(Text15.Text, 9, 2) > 31 Or Mid(Text15.Text, 9, 2) < 1 Then
msg = MsgBox("日期不正确", 16, "错误")
Text15.SetFocus
Exit Sub
End If
If Mid(Text16.Text, 9, 2) > 31 Or Mid(Text16.Text, 9, 2) < 1 Then
msg = MsgBox("月份不正确", 16, "错误")
Text16.SetFocus
Exit Sub
End If
If Mid(Text17.Text, 9, 2) > 31 Or Mid(Text17.Text, 9, 2) < 1 Then
msg = MsgBox("月份不正确", 16, "错误")
Text17.SetFocus
Exit Sub
End If


Dim sql As String
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
        Dim rs2 As ADODB.Recordset
Set rs2 = New Recordset
sql = "select * from [hetong] where (hetong_no='" & Trim(Combo1.Text) & "' or xgxy_no='" & Trim(Text2.Text) & "') and id<>" & Text20.Text
rs2.Open sql, con, 1, 1
If Not rs2.EOF Then
msg = MsgBox("对不起，数据库中已有相同的合同草稿号或相同的相关协议号", 16, "错误")
Exit Sub
End If
Dim rs As ADODB.Recordset
Set rs = New Recordset
sql = "select * from hetong where id=" & Text20.Text
rs.Open sql, con, 3, 2
If rs.EOF Then
msg = MsgBox("没有当前记录", 16, "出错拉")
Exit Sub
End If
'添加记录拉

rs![hetong_no] = Trim(Combo1.Text)
rs![xgxy_no] = Trim(Text2.Text)
rs![pingdao] = Trim(Text3.Text)
rs![leibie] = Trim(Text4.Text)
rs![playnumber] = Trim(Text5.Text)
rs![playtime] = Trim(Text6.Text)
rs![Money] = Trim(Text7.Text)
rs![othermoney] = Trim(Text8.Text)
rs![playmoney] = Trim(Text9.Text)
rs![sulemoney] = Trim(Text10.Text)
rs![bochumoney] = Trim(Text11.Text)
rs![weiyuemoney] = Trim(Text12.Text)
rs![allmoney] = Trim(Text13.Text)
rs![moneymoeny] = Trim(Text14.Text)
rs![qianyue_date] = Trim(Text15.Text)

rs![start_date] = Trim(Text16.Text)
rs![end_date] = Trim(Text17.Text)
rs![whoown] = Trim(Text18.Text)
If Trim(Text19.Text) <> "" Then
rs![otherinfo] = Trim(Text19.Text)
Else
rs![otherinfo] = " "
End If
rs.Update
rs.Close
Set rs = Nothing
con.Close
Set con = Nothing
msg = MsgBox("修改成功！", 32, "修改成功拉")
End Sub

Private Sub Command3_Click()
Unload Me
frmmain.Show
End Sub

Private Sub Form_Load()
Command1.Enabled = False

Dim sql As String
Dim str As String
Dim con As ADODB.Connection
Set con = New Connection
str = "provider=microsoft.jet.oledb.4.0;Data Source=" & App.Path & "\database.mdb"
con.Open str
Dim rs As ADODB.Recordset
Set rs = New Recordset
sql = "select distinct hetong_no from hetong "
rs.Open sql, con, 1, 1
If Not rs.EOF Then

Combo1.Text = rs!hetong_no
Else
msg = MsgBox("当前没有任何广告合同信息", 16, "错误")
Me.Hide
frmmain.Show
Exit Sub
End If

Do While Not rs.EOF
Combo1.AddItem (rs!hetong_no)
rs.MoveNext
Loop

rs.Close
End Sub