Question

我对vba有些新意，我尝试创建一个比条件格式菜单更复杂的条件格式。我有一个包含22个目标日期和实际日期字段的表单。对于我需要的每一对：

如果目标日期将来超过7天，请将其涂成绿色。如果目标日期在将来少于7天或今天，则将其着色为黄色如果是过去的目标日期，请将其涂成红色。

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

如果实际日期早于目标日期，则颜色均为绿色如果实际日期在目标日期之后，则颜色均为红色。

因为我必须在表单加载和任何日期字段的更改上执行此操作（目标日期计算，但如果表单中的其他数据更改将更改），我想写一个公共子表单名称，目标日期和实际日期作为变量。我能够使用＆＃39; Me.txtbox＆＃39;在本地表单模块上对每个框进行编码。但是，当我尝试从public sub引用表单和文本框时，似乎我没有正确引用表单上的文本框。我尝试了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

CurrentForm.name是一个字符串。它是Name对象的CurrentForm属性。 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 2

您可以直接在子资源中使用文本框参数。

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

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 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

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

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

3 个答案: