管理员.frm

该课题采用VB+SQLSERVER实现一个管理系统

        Exit Sub
    End If
GoTo li1
li2: MsgBox "添加失败"
li1:

End Sub

Private Sub Command10_Click()
Dim Rs3 As New ADODB.Recordset
Dim kucun As String
Dim c As Integer
c = Text8(2).Text
Set Rs3 = New Recordset
kucun = " update  药品库存信息 set 存量= 存量 - " & c & "  where 药品名称 = '" & Text2(3).Text & "'and 编号 = '" & Text1(3).Text & "'"
Rs3.Open kucun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li3



Dim Rs2 As New ADODB.Recordset
Dim xiaoshoujiage As String
Dim jiage As Integer
Set Rs2 = New Recordset
xiaoshoujiage = " select * from 药品基本信息 where 药品名称 = '" & Text2(3).Text & "'and 编号 = '" & Text1(3).Text & "'"
Rs2.Open xiaoshoujiage, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li3
jiage = Rs2(2)


Dim Rs1 As New ADODB.Recordset
Dim tianjia As String
Set Rs1 = New Recordset
tianjia = " select * from 药品使用情况信息 "
Rs1.Open tianjia, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Rs1.AddNew
With Rs1
.Fields("编号") = Text1(3).Text
.Fields("医院名称") = Text2(4).Text
.Fields("药品名称") = Text2(3).Text
.Fields("经手药师") = Text9(2).Text
.Fields("医师") = Text9(1).Text
.Fields("用量") = Text8(2).Text
.Fields("开药日期") = DateSerial(Combo2(3).Text, Combo3(3).Text, Combo4(3).Text)
.Fields("销售价格") = jiage
.Fields("病人id") = Text11.Text
 If MsgBox("成功添加还要继续么", vbOKCancel + vbQuestion, "退出") = vbOK Then
        Unload Me
        Form8.Show
        
    Else
        Exit Sub
    End If
End With
Rs1.Update

GoTo li1
li2: MsgBox "添加错误"
li3: MsgBox "药品没有库存或名称与编号不符"
li1:
End Sub

Private Sub Command11_Click()
 If MsgBox("确实要退出吗?", vbOKCancel + vbQuestion, "系统退出") = vbOK Then
        Unload Me
    Else
        Exit Sub
    End If
End Sub

Private Sub Command12_Click()
Unload Me
Form1.Show
End Sub

Private Sub Command13_Click()
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Set Rs1 = New Recordset
chaxun = " select * from 药品基本信息 where 编号 = '" & Text1(0).Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Text2(0).Text = Rs1(1)

Text3(2).Text = Rs1(2)
Text3(1).Text = Rs1(3)
Text4(1).Text = Rs1(4)
Dim s() As String
Dim a As String
a = Rs1(5)
s = Split(a, "-")


Combo2(1).Text = s(0)
Combo3(1).Text = s(1)
Combo4(1).Text = s(2)
Text5(1).Text = Rs1(6)
Text6(1).Text = Rs1(7)
Text7(1).Text = Rs1(8)
GoTo li1
li2: MsgBox "没有要查资料"
li1:
End Sub

Private Sub Command14_Click()
Dim Rs1 As New ADODB.Recordset
Dim tianjia As String
Set Rs1 = New Recordset
tianjia = " select * from 药品基本信息 "
Rs1.Open tianjia, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Rs1.AddNew
With Rs1
.Fields("编号") = Text1(0).Text
.Fields("药品名称") = Text2(0).Text
.Fields("进货价格") = Text3(2).Text
.Fields("销售价格") = Text3(1).Text
.Fields("生产厂家") = Text4(1).Text
.Fields("功能") = Text5(1).Text
.Fields("用法") = Text6(1).Text
.Fields("用量") = Text7(1).Text
.Fields("生产日期") = DateSerial(Combo2(1).Text, Combo3(1).Text, Combo4(1).Text)
Rs1.Update

 If MsgBox("成功添加还要继续么", vbOKCancel + vbQuestion, "退出") = vbOK Then
        Unload Me
        Form8.Show
        
    Else
        Exit Sub
    End If
End With
Rs1.Update
GoTo li1
li2: MsgBox "添加错误"
li1:
End Sub

Private Sub Command15_Click()
Unload Me
Form8.Show
Text1(0).Enabled = True
Text2(0).Enabled = True
Text3(2).Enabled = True
Text3(1).Enabled = True
Text4(1).Enabled = True
Text5(1).Enabled = True
Text6(1).Enabled = True
Text7(1).Enabled = True
Command14.Enabled = True
Combo2(1).Enabled = True
Combo3(1).Enabled = True
Combo4(1).Enabled = True

End Sub

Private Sub Command16_Click()
Unload Me
Form8.Show
Text1(2).Enabled = True
Text2(2).Enabled = True
Text8(0).Enabled = True
Command9.Enabled = True
Combo2(2).Enabled = True
Combo3(2).Enabled = True
Combo4(2).Enabled = True

End Sub

Private Sub Command17_Click()
Unload Me
Form8.Show
Text1(3).Enabled = True
Text2(4).Enabled = True
Text2(3).Enabled = True
Text8(2).Enabled = True
Text9(1).Enabled = True
Text9(2).Enabled = True
Text11.Enabled = True
Command10.Enabled = True
Combo2(3).Enabled = True
Combo3(3).Enabled = True
Combo4(3).Enabled = True

End Sub

Private Sub Command2_Click()
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Set Rs1 = New Recordset
chaxun = " select * from 医生信息 where id = '" & Text1(1).Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Text2(1).Text = Rs1(1)

If Rs1(2) = "男" Then
  Option1.Value = True
  Else
   Option2.Value = True
End If

Text3(0).Text = Rs1(3)
Combo1.Text = Rs1(4)
Text4(0).Text = Rs1(5)
Dim s() As String
Dim a As String
a = Rs1(6)
s = Split(a, "-")


Combo2(0).Text = s(0)
Combo3(0).Text = s(1)
Combo4(0).Text = s(2)
Text5(0).Text = Rs1(7)
Text6(0).Text = Rs1(8)
Text7(0).Text = Rs1(9)
Text8(1).Text = Rs1(10)
Text9(0).Text = Rs1(11)
Text10.Text = Rs1(12)

GoTo li1
li2: MsgBox "查询失败"
li1:
End Sub



Private Sub Command3_Click(Index As Integer)
Unload Me
Form8.Show
Text1(1).Enabled = True
Text2(1).Enabled = True
Text3(0).Enabled = True
Text4(0).Enabled = True
Text5(0).Enabled = True
Text6(0).Enabled = True
Text7(0).Enabled = True
Text8(1).Enabled = True
Text9(0).Enabled = True
Text10.Enabled = True
Combo1.Enabled = True
Combo2(0).Enabled = True
Combo3(0).Enabled = True
Combo4(0).Enabled = True
Option1.Enabled = True
Option2.Enabled = True
Command1(0).Enabled = True
End Sub





Private Sub Command4_Click(Index As Integer)
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Dim shanchu As String
Dim sex As String
Set Rs1 = New Recordset
chaxun = " select * from 医生信息 where id = '" & Text1(1).Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText

On Error GoTo li2
If Option1.Value = True Then
 sex = "男"
  Else
    sex = "女"
 End If

Dim s() As String
Dim a As String
a = Rs1(6)
s = Split(a, "-")


 If Text2(1).Text = Rs1(1) And sex = Rs1(2) And Text3(0).Text = Rs1(3) And Combo1.Text = Rs1(4) And Text4(0).Text = Rs1(5) And Combo2(0).Text = s(0) And Combo3(0).Text = s(1) And Combo4(0).Text = s(2) And Text5(0).Text = Rs1(7) And Text6(0).Text = Rs1(8) And Text7(0).Text = Rs1(9) And Text8(1).Text = Rs1(10) And Text9(0).Text = Rs1(11) And Text10.Text = Rs1(12) Then
 MsgBox "不需修改"
 Exit Sub
 End If
 Set Rs1 = New Recordset
 shanchu = "delete  from 医生信息 where id = '" & Text1(1).Text & "'"
 Rs1.Open shanchu, Str, adOpenKeyset, adLockOptimistic, adCmdText
 
 On Error GoTo li2

 Dim tianjia As String
Set Rs1 = New Recordset
tianjia = " select * from 医生信息 "
Rs1.Open tianjia, Str, adOpenKeyset, adLockOptimistic, adCmdText
Rs1.AddNew
With Rs1
.Fields("id") = Text1(1).Text
.Fields("姓名") = Text2(1).Text
.Fields("年龄") = Text3(0).Text
.Fields("专业") = Text4(0).Text
.Fields("家庭地址") = Text5(0).Text
.Fields("联系方式") = Text6(0).Text
.Fields("科别") = Text7(0).Text
.Fields("职务") = Text8(1).Text
.Fields("职称") = Text9(0).Text
.Fields("专长") = Text10.Text
.Fields("学历") = Combo1.Text
.Fields("出生日期") = Combo2(0).Text - Combo3(0).Text - Combo4(0).Text
If Option1.Value = True Then
  .Fields("性别") = "男"
  Else
    .Fields("性别") = "女"
 End If
End With
Rs1.Update

 If MsgBox("修改成功还要继续么", vbOKCancel + vbQuestion, "退出") = vbOK Then
        Unload Me
        Form8.Show
        
    Else
        Exit Sub
    End If
  

GoTo li1
li2: MsgBox "修改失败"
li1:
End Sub

Private Sub Command5_Click(Index As Integer)
Unload Me
Form1.Show
End Sub





Private Sub Command6_Click(Index As Integer)
 If MsgBox("确实要退出吗?", vbOKCancel + vbQuestion, "系统退出") = vbOK Then
        Unload Me
    Else
        Exit Sub
    End If
End Sub

Private Sub Command7_Click()
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Dim i As Integer
i = 0
Set Rs1 = New Recordset
chaxun = " select * from 药品使用情况信息 where 编号 = '" & Text1(3).Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
If Rs1.EOF = False Then
Rs1.MoveFirst
End If
Do While Rs1.EOF = False
        Text2(4).Text = Rs1(1)

        Text2(3).Text = Rs1(3)
        Text8(2).Text = Rs1(4)
        Text9(1).Text = Rs1(5)
        Text9(2).Text = Rs1(6)
        Text11.Text = Rs1(8)
        Dim s() As String
        Dim a As String
         a = Rs1(2)
         s = Split(a, "-")
       Combo2(3).Text = s(0)
       Combo3(3).Text = s(1)
       Combo4(3).Text = s(2)
       
   Rs1.MoveNext
  MsgBox "查下一条记录"
Loop

GoTo li1
li2: MsgBox "没有要查资料"
li1:
End Sub

Private Sub Command8_Click()
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Set Rs1 = New Recordset
chaxun = " select * from 药品库存信息 where 编号 = '" & Text1(2).Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Text2(2).Text = Rs1(1)
Text8(0).Text = Rs1(3)

Dim s() As String
Dim a As String
a = Rs1(2)
s = Split(a, "-")

Combo2(2).Text = s(0)
Combo3(2).Text = s(1)
Combo4(2).Text = s(2)
GoTo li1
li2: MsgBox "没有要查资料"
li1:
End Sub

Private Sub Command9_Click()
Dim Rs1 As New ADODB.Recordset
Dim tianjia As String
Set Rs1 = New Recordset
tianjia = " select * from 药品库存信息 "
Rs1.Open tianjia, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Rs1.AddNew
With Rs1
.Fields("编号") = Text1(2).Text
.Fields("药品名称") = Text2(2).Text
.Fields("存量") = Text8(0).Text
.Fields("入库日期") = DateSerial(Combo2(2).Text, Combo3(2).Text, Combo4(2).Text)
Rs1.Update

 If MsgBox("成功添加还要继续么", vbOKCancel + vbQuestion, "退出") = vbOK Then
        Unload Me
        Form8.Show
        
    Else
        Exit Sub
    End If
End With
Rs1.Update
GoTo li1
li2: MsgBox "添加错误"
li1:

End Sub