|
把下面的代码全部替换你的代码，基本所有问题都已解决
Dim CNN As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim NE As String, Exec As String, publicdex As Integer Private Sub UserForm_Initialize()
'On Error Resume Next
ComboBox1.List = Array("资产", "负债", "权益", "成本", "损益")
With ListView1
.View = lvwReport
.Gridlines = True
.FullRowSelect = True
.ColumnHeaders.Add , , "类型", 28
.ColumnHeaders.Add , , "科目编码", 55
.ColumnHeaders.Add , , "总账科目", 90
.ColumnHeaders.Add , , "明细科目", 95
.ColumnHeaders.Add , , "方向", 28, lvwColumnCenter
.ColumnHeaders.Add , , "期初金额", 70, lvwColumnRight
.ColumnHeaders.Add , , "现金编码", 45, lvwColumnCenter
End With
ListView1.LabelEdit = 0 '内容不可修改
ComboBox1 = "资产"
'OptionButton1.Value = True
TextBox3.SetFocus
End Sub Private Sub ComboBox1_Change() '自动搜索数据
Call 查询科目
Call 清空文本
TextBox3.SetFocus
End Sub Private Sub CommandButton1_Click() '新增数据
Dim s$, i%
For i = 1 To ListView1.ListItems.Count
s = s & " " & ListView1.ListItems(i).SubItems(1)
Next
If ComboBox1 = "" Or TextBox3 = "" Or TextBox4 = "" Or TextBox6 = "" Then
MsgBox "数据不完整,请核对后录入!", vbCritical, "凭证处理系统": Exit Sub
ElseIf InStr(s, TextBox3.Text) Then
MsgBox "科目已存在", vbCritical, "凭证处理系统": Call 清空文本: Exit Sub
Else
If MsgBox("是否确认新增科目的数据?", vbYesNo + vbQuestion, "凭证处理系统") = vbNo Then
Call 清空文本: Exit Sub
End If
Call 输入科目
Call 查询科目
Call 清空文本
MsgBox "会计科目新增完毕!", vbInformation, "凭证处理系统"
End If
TextBox3.SetFocus
End Sub Private Sub CommandButton2_Click() '修改数据
Application.ScreenUpdating = False
If ComboBox1 = "" Or TextBox3 = "" Or TextBox4 = "" Or TextBox6 = "" Then
MsgBox "数据不完整,请核对后修改!", vbCritical, "凭证处理系统": Exit Sub
Else
If MsgBox("是否确认修改科目的数据?", vbYesNo + vbQuestion, "凭证处理系统") = vbYes Then
Call 修改科目
Call 查询科目
Call 清空文本
Else
Call 清空文本: Exit Sub '
End If
MsgBox "会计科目修改完毕!", vbInformation, "凭证处理系统"
End If
Application.ScreenUpdating = True
TextBox3.SetFocus
End Sub Private Sub CommandButton3_Click() '删除数据
If ComboBox1 = "" Or TextBox3 = "" Or TextBox4 = "" Or TextBox6 = "" Then
MsgBox "数据不完整,请核对后删除!", vbCritical, "凭证处理系统": Exit Sub
Else
If MsgBox("是否确认删除科目的数据?", vbYesNo + vbQuestion, "凭证处理系统") = vbNo Then
Call 清空文本: Exit Sub
End If
Call 删除科目
Call 查询科目
Call 清空文本
MsgBox "会计科目删除完毕!", vbInformation, "凭证处理系统"
End If
TextBox3.SetFocus
End Sub Private Sub CommandButton4_Click()
UserForm7.Show
End Sub Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
'On Error Resume Next
publicdex = Item.Index
ComboBox1 = ListView1.SelectedItem.Text
TextBox3 = ListView1.SelectedItem.SubItems(1)
TextBox4 = ListView1.SelectedItem.SubItems(2)
TextBox5 = ListView1.SelectedItem.SubItems(3)
TextBox6 = ListView1.SelectedItem.SubItems(4)
TextBox7 = ListView1.SelectedItem.SubItems(5)
'TextBox8 = ListView1.SelectedItem.SubItems(6)
Label8.Caption = ListView1.SelectedItem.SubItems(1)
End Sub Sub 输入科目()
'On Error Resume Next
CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" _
& ThisWorkbook.Path & "\凭证数据库.mdb"
SQL = "Select * From 科目表"
rst.Open SQL, CNN, adOpenKeyset, adLockOptimistic
rst.AddNew
rst.Fields("类型") = ComboBox1.Text
rst.Fields("科目编码") = IIf(TextBox3.Text = "", Null, TextBox3.Text)
rst.Fields("总账科目") = IIf(TextBox4.Text = "", Null, TextBox4.Text)
rst.Fields("明细科目") = IIf(TextBox5.Text = "", Null, TextBox5.Text)
rst.Fields("方向") = IIf(TextBox6.Text = "", Null, TextBox6.Text)
rst.Fields("期初金额") = IIf(TextBox7.Text = "", Null, TextBox7.Text)
rst.Update
rst.Close
Set rst = Nothing
End Sub Sub 查询科目()
On Error Resume Next
CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" _
& ThisWorkbook.Path & "\凭证数据库.mdb"
SQL = "Select * From 科目表 Where 类型='" & ComboBox1.Text & "' Order by 科目编码"
rst.Open SQL, CNN, adOpenKeyset, adLockReadOnly
ListView1.ListItems.Clear
For i = 1 To rst.RecordCount
ListView1.ListItems.Add , , rst.Fields("类型")
ListView1.ListItems(i).SubItems(1) = rst.Fields("科目编码")
ListView1.ListItems(i).SubItems(2) = rst.Fields("总账科目")
ListView1.ListItems(i).SubItems(3) = IIf(IsNull(rst.Fields("明细科目")), "", rst.Fields("明细科目"))
ListView1.ListItems(i).SubItems(4) = rst.Fields("方向")
ListView1.ListItems(i).SubItems(5) = Format(rst.Fields("期初金额"), "#,##0.00")
rst.MoveNext
Next i
rst.Close
Set rst = Nothing
CNN.Close: Set CNN = Nothing
End Sub Sub 修改科目()
Dim SQL As String
Dim CNN As New ADODB.Connection
CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" _
& ThisWorkbook.Path & "\凭证数据库.mdb"
SQL = "Update 科目表 Set 类型='" & Me.ComboBox1.Text & "',"
SQL = SQL & " 科目编码='" & Me.TextBox3.Text & "',"
SQL = SQL & " 总账科目='" & Me.TextBox4.Text & "',"
SQL = SQL & " 明细科目='" & Me.TextBox5.Text & "',"
SQL = SQL & " 方向='" & Me.TextBox6.Text & "',"
SQL = SQL & " 期初金额=" & Val(TextBox7.Text) & ""
SQL = SQL & " Where 科目编码='" & Me.Label8.Caption & "'"
CNN.Execute SQL
CNN.Close
Set CNN = Nothing
With ListView1.ListItems(publicdex)
.Text = ComboBox1.Text
.SubItems(1) = Me.TextBox3.Text
.SubItems(2) = Me.TextBox4.Text
.SubItems(3) = Me.TextBox5.Text
.SubItems(4) = Me.TextBox6.Text
.SubItems(5) = Me.TextBox7.Text
End With
End Sub Sub 删除科目()
'On Error Resume Next
CNN.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" _
& ThisWorkbook.Path & "\凭证数据库.mdb"
SQL = "Delete From 科目表 Where 科目编码 = '" & TextBox3.Text & "'"
CNN.Execute (SQL)
End Sub Sub 清空文本()
'On Error Resume Next
TextBox3 = "": TextBox4 = "": TextBox5 = ""
TextBox6 = "": TextBox7 = "":: TextBox8 = "": 'Label8.Caption = ""
End Sub
| 
楼主: fecmen
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2008-8-30 11:26
