从全局子更改访问表单的格式

Question

我对 vba 有点陌生，我正在尝试创建一种比 access 2013 允许从条件格式菜单更复杂的条件格式。我有一个包含 22 个目标日期和实际日期字段的表格。对于我需要的每一对：

如果目标日期在未来 7 天以上，则将其涂成绿色。 如果目标日期在未来不到 7 天或者是今天，则将其涂成黄色 如果目标日期在过去，则将其涂成红色。

除非有一个实际的完成日期，在这种情况下：

如果实际日期早于目标日期，则将两个日期都涂成绿色 如果实际日期晚于目标日期，则将两个日期都涂成红色。

因为我必须在表单加载和任何日期字段的更改时执行此操作（计算目标日期，但如果表单中的其他数据发生更改，则会更改），我想编写一个公共子程序表单名称、目标日期和实际日期作为变量。我能够使用“Me.txtbox”在本地表单模块上对每个框进行编码以执行此操作 但是，当我尝试从公共子目录中引用表单和文本框时，似乎我没有正确引用表单上的文本框。我已经尝试了 3 或 4 种不同的方法（字符串、textbox.name 等），我觉得我很接近了，但是......

在表单模块中按需要工作的代码

Private Sub txtFreqReqDate_AfterUpdate()
  If Me.txtFreqReqDate <= Me.txtFreqReq Then
    Me.txtFreqReq.Format = "mm/dd/yyyy[green]"
    Me.txtFreqReqDate.Format = "mm/dd/yyyy[green]"
  ElseIf Me.txtFreqReqDate > Me.txtFreqReq Then
    Me.txtFreqReq.Format = "mm/dd/yyyy[red]"
    Me.txtFreqReqDate.Format = "mm/dd/yyyy[red]"
  ElseIf IsNull(Me.txtFreReqDate) = True Then
    If Me.txtFreqReq < Now() Then
      Me.txtFreqReq.Format = "mm/dd/yyyy[red]"
     ElseIf Me.txtFreqReq >= (Now()+7) Then
      Me.txtFreqReq.Format = "mm/dd/yyyy[yellow]"
     ElseIf Me.txtFreqReq > (Now()+7) Then
      Me.txtFreqReq.Format = "mm/dd/yyyy[green]"
     Else
      Me.txtFreqReq.Format = "mm/dd/yyyy[black]"
    End If
  Else
    Exit Sub
  End If
End Sub

也许不是最漂亮的，但我总是乐于接受建设性的批评。我必须为每对写 22 次以上，每次都更改文本框的名称。我想写一个只接受文本框名称的公共子，但我似乎找不到正确的组合：

Private Sub txtFreqReqDate_AfterUpdate()
  FormatBoxes(Me, me.txtFreqReqDate, me.txtFreqReq)
End Sub

在另一个模块中：

Public Sub FormatBoxes(CurrentForm As Form, txtActual as Textbox, txtTarget as Textbox)

frmName = CurrentForm.name
tbActual = txtActual.Name
tbTarget = txtTarget.Name


  If frmName.tbActual <= frmName.tbTarget Then
    frmName.tbTarget.Format = "mm/dd/yyyy[green]"
    frmName.tbActual.Format = "mm/dd/yyyy[green]"
  ElseIf frmName.tbActual > frmName.tbTarget Then
    frmName.tbTarget.Format = "mm/dd/yyyy[red]"
    frmName.tbActual.Format = "mm/dd/yyyy[red]"
  ElseIf IsNull(frmName.tbActual) = True Then
    If frmName.tbTarget < Now() Then
      frmName.tbTarget.Format = "mm/dd/yyyy[red]"
     ElseIf frmName.tbTarget >= (Now()+7) Then
      frmName.tbTarget.Format = "mm/dd/yyyy[yellow]"
     ElseIf frmName.tbTarget > (Now()+7) Then
      frmName.tbTarget.Format = "mm/dd/yyyy[green]"
     Else
      frmName.tbTarget.Format = "mm/dd/yyyy[black]"
    End If
  Else
    Exit Sub
  End If
End Sub

对不起，如果这有点长，我只是无能为力......

另外，对于任何错别字，我们深表歉意。我不得不在另一台机器上重新输入。

Answer 1

您可以直接在您的子程序中使用文本框参数。

甚至不需要将表单作为参数传递。

Public Sub FormatBoxes(txtActual as Textbox, txtTarget as Textbox)

  If txtActual.Value <= txtTarget.Value Then
      txtTarget.Format = "mm/dd/yyyy[green]"

等等

请注意，调用它时，您需要Call 或删除括号。

Private Sub txtFreqReqDate_AfterUpdate()
  Call FormatBoxes(me.txtFreqReqDate, me.txtFreqReq)
  ' or
  ' FormatBoxes me.txtFreqReqDate, me.txtFreqReq
End Sub

Answer 2

CurrentForm.name 是一个字符串。它是CurrentForm 对象的Name 属性。 CurrentForm 对象还有一个控件集合，texbox 就在其中。您可以在其中按名称引用它们，例如CurrentForm.Controls("tbTarget")，但您也可以说CurrentForm.tbTarget。所以你非常接近并且在正确的轨道上。

改变

frmName = CurrentForm.name
tbActual = txtActual.Name
tbTarget = txtTarget.Name

到

set frmName = CurrentForm
if frmName is not nothing then    
   set tbActual = txtActual
   set tbTarget = txtTarget
end if

或者，如果您在方法上的签名是

Public Sub FormatBoxes(CurrentForm As string, txtActual as string, txtTarget as string)

那么您的设置将如下所示

set frmName = forms(CurrentForm)
if frmName is not nothing then    
   set tbActual = frmName.controls(txtActual)
   set tbTarget = frmName.controls(txtTarget)
end if

但我认为第一个会更好。

Answer 3

我想发布完成的代码以帮助其他搜索此主题的人。我做了一些细化以使这个子更通用。 首先，我没有使用日期格式，而是只更改了 .ForeColor，允许我将此子用于任何类型的文本框。

Public Sub FormatBoxes(txtActual As TextBox, txtTarget As TextBox, chkRequired As CheckBox, _
Optional intOption as Integer)
Dim intRed As Long, intYellow As Long, intGreen As Long, inBlack As Long, intGray As Long
intBlack = RGB(0, 0, 0)
intGray = RGB(180, 180, 180)
intGreen = RGB (30, 120, 30)
intYellow = RGB(217, 167, 25)
intRed = RGB(255, 0, 0)

If (chkRequired = False) Then 
  txtTarget.ForeColor = intGray
  txtActual.ForeColor = intGray
  If intOption <> 1 Then
   txtTarget.Enabled = False
   txtActual.Enabled = False
   txtTarget.TabStop = False
   txtActual.TabStop = False
  End If
Else
  If intOption <> 1 Then
   txtTarget.Enabled = True
   txtActual.Enabled = True
   txtTarget.Locked = True
   txtActual.Locked = False
   txtTarget.TabStop = False
   txtActual.TabStop = True
  End If
  If IsBlank(txtActual) = True Then
   If txtTarget < Now() Then
    txtTarget.ForeColor = intRed
   ElseIf txtTarget > (Now() + 7) Then
    txtTarget.ForeColor = intGreen
   ElseIf txtTarget >= Now() And txtTarget <= (Now() +7) Then
    txtTarget.ForeColor = intYellow
   Else
    txtTarget.ForeColor = intBlack
   End If
  ElseIf intOption - 1 Then
   txtTarget.ForeColor = intBlack
   txtActual.ForeColor = intBlack
  ElseIf txtActual <= txtTarget Then
   txtTarget.ForeColor = intGreen
   txtActual.ForeColor = intGreen
  ElseIf txtActual > txtTarget Then
   txtTarget.ForeColor = intRed
   txtActual.ForeColor = intRed
  End If
End If
End Sub

如果您想知道，IsBlank() 是一个检查空字符串或零长度字符串的函数：

Public Function IsBlank(str_in As Variant) As Long
If Len(str_in & "") = 0 Then
  IsBlank = -1
Else
IsBlank = 0
End If
End Function

感谢所有帮助，我希望这对某人有用。