Блог

Я несколько новичок в 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
  

Извините, если это немного длинно, я просто в тупике…

Кроме того, приносим извинения за любые опечатки. Мне пришлось перепечатать это с другого компьютера.

Вы можете просто использовать параметры текстового поля непосредственно в своем вложенном стеке.

Даже нет необходимости передавать форму в качестве параметра.

 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
  

CurrentForm.name является строкой. Это Name свойство CurrentForm объекта. CurrentForm Объект также имеет коллекцию элементов управления, в которой находятся текстовые поля. Вы можете ссылаться на них по имени, например 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
  

Но я думаю, что первый будет работать лучше.

Я хотел опубликовать готовый код, чтобы помочь всем, кто ищет эту тему. Я сделал пару изменений, чтобы сделать этот подраздел более универсальным. Во-первых, вместо использования формата даты я изменил только .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 amp; "") = 0 Then
  IsBlank = -1
Else
IsBlank = 0
End If
End Function
  

Спасибо за всю помощь, и я надеюсь, что это кому-то полезно.