0

我正在为一些 VBA 代码和 BeforeSave 方法而苦苦挣扎。我一直在论坛上，但找不到我需要的答案，所以希望得到一些帮助。我的问题！在保存时，我需要代码来查看“表”（名为 Claims）的 H 列（名为 Claim USD）的数值，然后如果任何单元格具有值，则查看 I 列（名为 Claim Date）并确保那里有一个日期。我已经有数据验证列 I 只接受日期条目。

我找到了下面的代码，并测试了它的作用和工作原理。我只是不确定如何合并我的元素。谁能给我一些帮助？

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim rsave As Range
Dim cell As Range
Set rsave = Sheet2.Range("I8,I500")

For Each cell In rsave

If cell = "" Then

Dim missdata
missdata = MsgBox("missing data", vbOKOnly, "Missing Data")
Cancel = True
cell.Select

Exit For

End If

Next cell

End Sub
4

2 回答 2

0

我创建了一个自定义类进行验证，请参见此处。对于您要尝试做的事情来说，这太过分了，但它允许您做的是捕获所有有错误的单元格，然后对它们做您想做的事情。可以下载并导入 2 个类模块 Validator.cls 和 ValidatorErrors.cls ，然后使用下面的

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Unflag
  Dim rsave As Range
  Dim rcell As Range
  Dim v AS New Validator

  Set rsave = Sheet2.Range("Table1[Estimate Date]")
  with v
    For Each rcell In rsave
      .validates rcell,rcell.address
         .presence
    Next rcell
 End With
 If not(v.is_valid) Then
     FlagCollection v.errors
     MsgBox("Missing data in " & v.unique_keys.Count & " Cell(s).", vbOKOnly, "Missing Data")
     Cancel = True
 End IF
 Set v = Nothing
End Sub

Public Sub flag(flag As String, comment As String)
  Dim comments As String
  If has_comments(flag) Then
   comments = Sheet2.Range(flag).comment.Text & vbNewLine & comment
  Else
    comments = comment
  End If
  Sheet2.Range(flag).Interior.Color = RGB(255, 255, 102)
  Sheet2.Range(flag).ClearComments
  Sheet2.Range(flag).AddComment comments
End Sub

Public Sub FlagCollection(all_cells As Collection)
  Dim flag_cell As ValidatorError

  For Each flag_cell In all_cells
    flag flag_cell.field, flag_cell.error_message
  Next flag_cell
End Sub

Public Sub Unflag()
  Cells.Select
  Selection.Interior.ColorIndex = xlNone
  Selection.ClearComments
End Sub

Public Function has_comments(c_cell As String) As Boolean
   On Error Resume Next
   Sheet1.Range(c_cell).comment.Text
   has_comments = Not (CLng(Err.Number) = 91)
End Function

这会将每个有错误的字段标记为黄色并添加关于问题所在的注释您还可以确定一种方法来告诉用户错误在哪里使用 v.uniq_keys 返回失败的单元格地址集合存在的验证。

于 2013-12-16T18:11:59.207 回答
0

我很确定我破解了它，无论如何它都能正常工作。下面的代码（对于那些有兴趣的人！！）

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

     Dim rsave As Range
     Dim cell As Range

     Set rsave = Sheet2.Range("Table1[Estimated Claim (USD)]")

     For Each cell In rsave

          If cell.Value <> "" And cell.Offset(0, 1).Value = "" Then

          Dim missdata
          missdata = MsgBox("Missing Data - Enter the Date for WorkBook to Save", vbOKOnly, "Missing Data")
          Cancel = True
          cell.Offset(0, 1).Select

      Exit For

      End If

      Next cell

 End Sub

我现在必须通过其他三个列标题循环检查相同的标准。如果有人知道更快的代码方法。将不胜感激！

于 2013-12-13T14:50:23.100 回答