访问表单 - 从代码更新一个字段筛选器,而不会冲突现有筛选器

时间:2016-05-02 08:17:55

标签: vba ms-access filter access-vba

我有一个子表单,它有一个带代码源的字段(自定义VBA函数进行查找)。该字段上的过滤器按钮不起作用(按设计访问)。我的用户希望对此字段以及其他字段使用过滤器。

作为解决方法,我添加了3个复选框。如果用户单击其中任何一个复选框,则会根据函数字段将过滤器应用于子表单。

问题是,这会从子窗体中删除所有其他当前应用的过滤器。这对我的用户来说并不好。

有没有办法在不破坏剩余过滤器的情况下添加和删除一个字段条件进行过滤?

我曾尝试过强迫它,但我放弃了。当以正常方式添加过滤器时,会添加许多括号和AND个单词。我的小过滤器文本可以是过滤条件字符串迷宫中的任何位置。因此,使用文本函数来查找和操作它似乎是大,慢,愚蠢,不稳定和肮脏。

我在这里遗漏了什么吗?有没有更好的方法呢?

Dim tx As String

If Not Me.flProcDONE And Not Me.flProcNOK And Not Me.flProcOK Then
  tx = ""
Else
  tx = "stProc IN (" & IIf(Me.flProcDONE, kStProcUPD, "99") _
       & "," & IIf(Me.flProcNOK, kStProcNOK, "99") _
       & "," & IIf(Me.flProcOK, kStProcOK, "99") & ")"
End If
With Me.sfrApply.Form
 .Filter = tx
 .FilterOn = True
End With

(部分工作)蛮力代码:

  With Me.sfrApply.Form

    If .Filter = "" Then
      .Filter = tx
    Else
      If tx = "" Then
        lnStart = InStr(1, .Filter, "AND stProc IN (", vbTextCompare)
        If lnStart > 0 Then
          lnEnd = InStr(lnStart, .Filter, ")", vbTextCompare)
          .Filter = Left(.Filter, lnStart - 1) & Mid(.Filter, lnEnd + 1)
        End If
      Else
        lnStart = InStr(1, .Filter, "stProc", vbTextCompare)
        If lnStart > 0 Then
          lnEnd = InStr(lnStart, .Filter, ")", vbTextCompare)
          .Filter = Left(.Filter, lnStart - 1) & tx & Mid(.Filter, lnEnd + 1)
        Else
          .Filter = "(" & .Filter & ") AND (" & tx & ")"
        End If
      End If
    End If
    .FilterOn = True
 End With

它有一些错误,错过了一些括号。使它工作需要额外的4-5 IF s和更多Instr s。恶心。访问过滤不断向过滤器文本添加[](),这使得几乎无法从代码中进行操作。

.Form.Filter文本的几个例子:

  

"" - 没有过滤器

     

" stProc IN(99,99,1)" - 我试图操纵的那个

     

"([scrCarrierInvoiceGLSQuote]。[ctParcelQUOTE] In(1,2))"

     

"(([[stProc] In(99,99,1))))AND([scrCarrierInvoiceGLSQuote]。[ctParcelSI] = 1)"

     

"(([scrCarrierInvoiceGLSQuote]。[ctParcelQUOTE] In(1,2)))AND(stProc IN(99,99,1))"

     

"(([scrCarrierInvoiceGLSQuote]。[ctParcelQUOTE] In(1,2))AND([stProc] In(99,99,1))))AND([scrCarrierInvoiceGLSQuote]。[lsError]赞" COD&#34)"

2 个答案:

答案 0 :(得分:0)

我会尝试像

这样的东西
With Me.sfrApply.Form
 .Filter = .Filter & " AND " & tx
 .FilterOn = True
End With

这只是一个快速的样本,但你可以详细说明。

答案 1 :(得分:0)

好吧,我确实设法解决了这个问题。我找不到好的方法。基本上是:

  • 如果过滤字符串为空,只需将我的过滤字符串添加到其中
  • 如果有问题的过滤器部分不在过滤器字符串中,只需将其连接到它的末尾(如@iDevlop建议的那样)
  • 如果我要应用的过滤器已经是过滤器的一部分,只需更改它的“IN(...)”部分 - 永远不要尝试将其删除。

以下是代码:

Dim txFullFilter As String
Dim txFilterPart As String

Dim lnStProcPos As Long   'Position of the column name in the existing filter text
Dim lnOpenParPos As Long  'Position of the opening parentheses "(" after column name
Dim lnCloseParPos As Long 'Position of the closing parentheses ")" after the opening one

'Create the actual filter text form the column I'm trying to filter from outside.
  If Not Me.flProcDONE And Not Me.flProcNOK And Not Me.flProcOK Then
    txFilterPart = "0,1,3,7"
  Else
    txFilterPart = IIf(Me.flProcDONE, kStProcUPD, "99") _
         & "," & IIf(Me.flProcNOK, kStProcNOK, "99") _
         & "," & IIf(Me.flProcOK, kStProcOK, "99")
  End If
  txFullFilter = "stProc IN (" & txFilterPart & ")"

'Apply said filter to the subform
  With Me.sfrApply.Form
    If .Filter = "" Then
      .Filter = txFullFilter
    ElseIf InStr(.Filter, "stProc") > 0 Then
      lnStProcPos = InStr(.Filter, "stProc")
      lnOpenParPos = InStr(lnStProcPos, .Filter, "(")
      lnCloseParPos = InStr(lnOpenParPos, .Filter, ")")
      .Filter = Left(.Filter, lnOpenParPos) & txFilterPart & Mid(.Filter, lnCloseParPos)
    Else
      .Filter = .Filter & "AND " & txFullFilter
    End If
    .FilterOn = True
  End With