文本框百分比保存到Access出错求助

忘得快

各位老师早！
我将文本框百分比保存到Access出错，请教如何解决？谢谢！
文本框百分比保存到Access出错求助.rar (33.61 KB, 下载次数: 4)

2017-2-8 08:03 上传

点击文件名下载附件

xd3210

Private Sub TextBox3_Change() '解决TextBox3.Value为空时自动计算出错
    Dim t As Double
    On Error Resume Next
    t = (Val(TextBox3.Value) - Val(TextBox5.Value)) / Val(TextBox5.Value)
    If Err.Number = 0 Then
        TextBox4.Value = t
        TextBox4.Text = Format(TextBox4, "0.00")
    Else
        TextBox4.Value = 0
    End If
End Sub


Private Sub UserForm_Initialize()
ComboBox1.AddItem "办公室"
ComboBox1.AddItem "财务部"
ComboBox1.AddItem "销售部"
ComboBox3.AddItem "Z2014070001"
ComboBox3.AddItem "Z2014070002"
ComboBox3.AddItem "Z2014070003"
ComboBox3.AddItem "Z2014070004"
ComboBox3.AddItem "Z2014070005"
ComboBox3.AddItem "Z2014070006"
Label8.Caption = "比例(%):"
End Sub

Private Sub CommandButton1_Click() '查询
    'On Error GoTo 100
    If ComboBox3.Text = "" Then
        MsgBox "请输入工号", 1 + 16, "出错提示"
        ComboBox3.SetFocus
    Else
        Dim RS1 As Recordset
        Dim DB1 As Database
        
        Set DB1 = OpenDatabase(ThisWorkbook.Path & "\" & "Info.MDB")
        Set RS1 = DB1.OpenRecordset(Name:="信息", Type:=dbOpenDynaset)
         RS1.FindFirst "工号='" & ComboBox3.Value & "'"
         If RS1.NoMatch = True Then
            MsgBox "对不起，没有查到工号为：" & ComboBox3.Value & " 的相关信息"
            RS1.Close
            Exit Sub
         Else
             ComboBox1.Value = RS1.Fields("部门").Value
             TextBox2.Value = RS1.Fields("姓名").Value
             TextBox5.Value = RS1.Fields("预算").Value
             TextBox3.Value = RS1.Fields("实际").Value
             TextBox1.Value = RS1.Fields("顺序号").Value
'             TextBox4.Value = RS1.Fields("比例").Value
        End If
        RS1.Close
        Set RS1 = Nothing
        Set DB1 = Nothing
       TextBox4.Text = Format(TextBox4, "0.00")
    End If
   
    Exit Sub          '正常执行结束，跳出 sub
100:
        MsgBox "程序执行出错", 1 + 16, "系统提示"
End Sub

Private Sub CommandButton2_Click() '修改
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim X As Integer
    Dim myNo As String, SQL As String, myStr As String, varchar
    Dim rs As ADODB.Recordset
    Dim XGSJ As Date, Convert As Date
    Dim dls As Single, bgs As Single
    Dim bl
    Dim b As String
    'MsgBox "bL:" & bl
    cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & ThisWorkbook.Path & "\Info.mdb"
            SQL = "update 信息 set 部门='" & ComboBox1.Value & " ',姓名='" & TextBox2.Value & " ',预算='" & Me.TextBox5.Value & "'," _
                & "实际='" & Me.TextBox3.Value & "',比例=" & Val(TextBox4.Text) & " where 工号='" & ComboBox3.Value & "'"  'Access语句
            'MsgBox SQL
            cnn.Execute SQL
        MsgBox "保存成功！", vbInformation
    Set cnn = Nothing
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub

opiona

1.     SQL = "update 信息 set "
   
2.     SQL = SQL & " 部门='" & ComboBox1.Value & "'"  '//原来多个空格
   
3.     SQL = SQL & ",姓名='" & TextBox2.Value & "'"   '//原来多个空格
   
4.     SQL = SQL & ",预算=" & Me.TextBox5.Value   '//货币也是数字格式
   
5.     SQL = SQL & ",实际=" & Me.TextBox3.Value    '//货币也是数字格式
   
6.     SQL = SQL & ",比例=" & Replace(Me.TextBox4.Value, "%", "") * 1 / 100   '//转换为数字
   
7.     SQL = SQL & " where 工号='" & ComboBox3.Value & "'"    'Access语句
   

复制代码

xd3210

Private Sub TextBox3_Change() '解决TextBox3.Value为空时自动计算出错
    Dim t As Double
    On Error Resume Next
    t = (Val(TextBox3.Value) - Val(TextBox5.Value)) / Val(TextBox5.Value)
    If Err.Number = 0 Then
        TextBox4.Value = t
        TextBox4.Text = Format(TextBox4, "0.00")
    Else
        TextBox4.Value = 0
    End If
End Sub


Private Sub UserForm_Initialize()
ComboBox1.AddItem "办公室"
ComboBox1.AddItem "财务部"
ComboBox1.AddItem "销售部"
ComboBox3.AddItem "Z2014070001"
ComboBox3.AddItem "Z2014070002"
ComboBox3.AddItem "Z2014070003"
ComboBox3.AddItem "Z2014070004"
ComboBox3.AddItem "Z2014070005"
ComboBox3.AddItem "Z2014070006"
Label8.Caption = "比例(%):"
End Sub

Private Sub CommandButton1_Click() '查询
    'On Error GoTo 100
    If ComboBox3.Text = "" Then
        MsgBox "请输入工号", 1 + 16, "出错提示"
        ComboBox3.SetFocus
    Else
        Dim RS1 As Recordset
        Dim DB1 As Database
        
        Set DB1 = OpenDatabase(ThisWorkbook.Path & "\" & "Info.MDB")
        Set RS1 = DB1.OpenRecordset(Name:="信息", Type:=dbOpenDynaset)
         RS1.FindFirst "工号='" & ComboBox3.Value & "'"
         If RS1.NoMatch = True Then
            MsgBox "对不起，没有查到工号为：" & ComboBox3.Value & " 的相关信息"
            RS1.Close
            Exit Sub
         Else
             ComboBox1.Value = RS1.Fields("部门").Value
             TextBox2.Value = RS1.Fields("姓名").Value
             TextBox5.Value = RS1.Fields("预算").Value
             TextBox3.Value = RS1.Fields("实际").Value
             TextBox1.Value = RS1.Fields("顺序号").Value
'             TextBox4.Value = RS1.Fields("比例").Value
        End If
        RS1.Close
        Set RS1 = Nothing
        Set DB1 = Nothing
       TextBox4.Text = Format(TextBox4, "0.00")
    End If
   
    Exit Sub          '正常执行结束，跳出 sub
100:
        MsgBox "程序执行出错", 1 + 16, "系统提示"
End Sub

Private Sub CommandButton2_Click() '修改
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim X As Integer
    Dim myNo As String, SQL As String, myStr As String, varchar
    Dim rs As ADODB.Recordset
    Dim XGSJ As Date, Convert As Date
    Dim dls As Single, bgs As Single
    Dim bl
    Dim b As String
    'MsgBox "bL:" & bl
    cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & ThisWorkbook.Path & "\Info.mdb"
            SQL = "update 信息 set 部门='" & ComboBox1.Value & " ',姓名='" & TextBox2.Value & " ',预算='" & Me.TextBox5.Value & "'," _
                & "实际='" & Me.TextBox3.Value & "',比例=" & Val(TextBox4.Text) & " where 工号='" & ComboBox3.Value & "'"  'Access语句
            'MsgBox SQL
            cnn.Execute SQL
        MsgBox "保存成功！", vbInformation
    Set cnn = Nothing
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub

opiona

2013.rar (32.06 KB, 下载次数: 7)

2017-2-8 09:43 上传

点击文件名下载附件

忘得快

xd3210 发表于 2017-2-8 09:41
Private Sub TextBox3_Change() '解决TextBox3.Value为空时自动计算出错
    Dim t As Double
    On E ...

谢谢你的回复，很遗憾，你的代码也出错！请你自己先试一试。

xd3210

忘得快 发表于 2017-2-8 23:37
谢谢你的回复，很遗憾，你的代码也出错！请你自己先试一试。

我的机器上可以运行。
有三处做了改动：
TextBox4.Text = Format(TextBox4, "0.00")
Label8.Caption = "比例(%):"
SQL = "update 信息 set 部门='" & ComboBox1.Value & " ',姓名='" & TextBox2.Value & " ',预算='" & Me.TextBox5.Value & "'," _
                & "实际='" & Me.TextBox3.Value & "',比例=" & Val(TextBox4.Text) & " where 工号='" & ComboBox3.Value & "'"

xd3210

小数与百分数转换进行了修正，供参考。另外，原SQL更新中，字符串后有空格，导致初次调入没有问题，一旦修改保存后再次调会出错。

忘得快

xd3210 发表于 2017-2-9 08:55
小数与百分数转换进行了修正，供参考。另外，原SQL更新中，字符串后有空格，导致初次调入没有问题，一旦修 ...

奇怪！用你的文件修改保存不会出错，将代码复制到的我的文件上就出错了，不知是何原因？
另外，字符串后有空格是怎么产生的？请教如何避免和消除空格？谢谢！