excel - 文本框中的 VBA 用户未从工作表中填充
问题描述
我有一个详细查询的列表框,当在列表框中的一行上使用双击时,会打开第二个用户窗体以允许更新信息,我遇到的问题是应该来自 13 的日期& 第 14 列未转移回文本框:
.Offset(0, 13).Value, txtnotes.Value, _
.Offset(0, 14).Value, txtdtime.Value)
其他组合框和文本框正在检索正确的数据,但这些最终框不会消失。
这是完整的代码:
Private Sub UserForm_Initialize()
'dim the variables
Dim i As Integer
On Error Resume Next
'find the selected list item
i = frmenqnew.lstenq.ListIndex
'add the values to the text boxes
Me.txtenqup.Value = frmenqnew.lstenq.Column(0, i)
Me.txtcustup.Value = frmenqnew.lstenq.Column(1, i)
Me.cboup3.Value = frmenqnew.lstenq.Column(4, i)
Me.cboup4.Value = frmenqnew.lstenq.Column(5, i)
Me.cboup5.Value = frmenqnew.lstenq.Column(6, i)
Me.cboup6.Value = frmenqnew.lstenq.Column(7, i)
Me.txtrev.Value = frmenqnew.lstenq.Column(9, i)
Me.txtnotes.Value = frmenwnew.lstenq.Column(13, i)
Me.txtdtime.Value = frmenwnew.lstenq.Column(14, i)
With cboup5
.AddItem "Active"
.AddItem "Dormant"
.AddItem "Lost"
.AddItem "Sold"
End With
With cboup6
.AddItem "Drawing"
.AddItem "Appraisal"
.AddItem "Verification"
.AddItem "Presenting"
End With
On Error GoTo 0
End Sub
Private Sub cmdUpdate_Click()
' To write edited info of userform2 to Sheets("Data")
Dim LastRow As Long
Dim ABnum As Double
Dim ABrng As Range
Dim WriteRow As Long
'error statement
On Error GoTo errHandler:
'hold in memory and stop screen flicker
Application.ScreenUpdating = False
' Make sure we're on the right sheet
With Sheets("Data")
' Get the last row used so can set up the search range
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' Set the range to search for the AB number
Set ABrng = .Range("A1:A" & LastRow)
' Get the AB number from what is selected on userform2
ABnum = txtenqup.Value
' Get the row of sheet for this AB number
WriteRow = Application.Match(ABnum, ABrng, 0)
' Make this AB number the active cell
With .Cells(WriteRow, 1)
'Check for changes
If Not hasValuePairsChanges(.Offset(0, 4).Value, cboup3.Value, _
.Offset(0, 5).Value, cboup4.Value, _
.Offset(0, 6).Value, cboup5.Value, _
.Offset(0, 7).Value, cboup6.Value, _
CDate(.Offset(0, 8).Value), Date, _
CDbl(.Offset(0, 9).Value), CDbl(txtrev.Value), _
.Offset(0, 13).Value, txtnotes.Value, _
.Offset(0, 14).Value, txtdtime.Value) Then
MsgBox "No Change in Data", vbInformation, ""
Exit Sub
End If
' Write in all the editable options
.Offset(0, 4) = cboup3.Value
.Offset(0, 5) = cboup4.Value
.Offset(0, 6) = cboup5.Value
.Offset(0, 7) = cboup6.Value
.Offset(0, 8) = Date
.Offset(0, 9) = txtrev.Value
.Offset(0, 13) = txtnotes.Value
.Offset(0, 14) = txtdtime.Value
Sheets("Archive").Range("A" & Rows.Count).End(xlUp)(2).Resize(, 14).Value = .Resize(, 14).Value
End With
End With
' Filter the Data
FilterMe
' Close the form
Unload Me
MsgBox ("Enquiry E0" + Me.txtenqup.Text + " has been updated")
errHandler:
'Protect all sheets if error occurs
'Protect_All
'show error information in a messagebox
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " just occured."
End If
End Sub
Function hasValuePairsChanges(ParamArray Args() As Variant) As Boolean
Dim n As Long
For n = 0 To UBound(Args) Step 2
If Not Args(n) = Args(n + 1) Then
hasValuePairsChanges = True
Exit Function
End If
Next
End Function
非常感谢任何帮助
谢谢
解决方案
推荐阅读
- java - JWT,我们如何为 Java 和 NodeJS 使用相同的 RSA 密钥对
- javascript - 加法运算符在 Javascript 中不起作用。如果我做 20+10,它会给我 2010 而不是 30。我该如何解决这个问题?
- python - 如何使用 Alexa Skill Kit SDK 导入 Python 外部库?
- docker - Bazel - 在 Monorepo 中构建、推送、部署 Docker 容器到 Kubernetes
- reactjs - 在 Action Creators 中实例化一个新的 Howler 对象并在事件上调度操作
- go - 使用自定义 http.ResponseWriter 根据代理请求的响应编写 cookie?
- node.js - 无法使用 node v12.6 安装 probufJs
- git - 从标签推送 gitlab-ci 中获取“创建自”分支名称
- css - 使用一些组件我看到定义的索引类
- javascript - 如何在本机反应中导入其他文件夹中存在的图像?