Office中国论坛/Access中国论坛

标题: 【分享函数】设置窗体默认的过滤条件 [打印本页]

作者: admin 时间: 2012-5-12 09:22
标题: 【分享函数】设置窗体默认的过滤条件
'===============================================================================-----天鸣科技--->>>>>>>>
'-函数名称:       gt_GetDefaultFilter
'-功能描述:       设置默认的过滤条件
'-输入参数:       参数1:rstrFormName String 窗体名称
'-返回参数:       无
'-使用示例:       gt_GetDefaultFilter "frmMainMenu"
'-相关调用:       无
'-使用注意:       暂时只适用静态条件，不能取动态条件，如只能取3月流水帐，不能取当月流水帐资料
'-兼容性:       97,2000,XP,2003 compatible
'-参考资料:
'-作者:       王宇虹  修改：王宇虹
'-创建日期;       2002-08-26  更新日期: 2012-05-01
'-图解:
'===============================================================================--<>>>>>
Public Function gt_GetDefaultFilter(rstrFrmName As String) As String

Dim rstTemp As New ADODB.Recordset
Dim strDftFltName As String
Dim strWhere As String
rstTemp.Open "select ffiltername from tblZstmFilterSave where fform='" & rstrFrmName & "' and fuser='" & gt_strUserName & "' and fisdefault=true ", CodeProject.Connection, adOpenStatic, adLockReadOnly
If rstTemp.RecordCount > 0 Then
      strDftFltName = rstTemp.Fields("ffiltername")
Else
      strDftFltName = ""
End If
rstTemp.Close
'strDftFltName = Nz(DLookup("ffiltername", "tblZstmFilterSave", "fform='" & Me.Name & "' and fuser='" & gt_strUserName & "' and fisdefault=true "))
CodeDb.Execute "delete * from tblZstmFilter"
CodeDb.Execute "insert into tblZstmFilter (FId, FSeq, Fform, FName, FRela, FField, FCaption, FLogic, FValue, FType) select FId, FSeq, fform, FName, FRela, FField, FCaption, FLogic, FValue, FType from tblZstmFilterSaveDetail where ffiltername='" & strDftFltName & "' and fform='" & rstrFrmName & "' and fuser='" & gt_strUserName & "'"

Dim varName As Variant
Dim strTmp As String
Dim i, j As Integer

Dim strCtlL, strValue, strLogic, pPara As String

Dim strSql As String
strSql = "select * from tblZstmFilter  where fform='" & rstrFrmName & "' order by fseq"
rstTemp.Open strSql, CodeProject.Connection, adOpenStatic, adLockReadOnly

pPara = ""
Do While Not rstTemp.EOF
      i = i + 1
      If i = 1 Then
         strCtlL = " "
      Else
         strCtlL = IIf(rstTemp("FRela") = "或", " or ", " and ")
      End If
      strValue = rstTemp("FValue")
      strLogic = Trim(rstTemp("FLogic"))
      If strLogic = "$" Then
         strValue = "*" & strValue & "*"
         strLogic = " LIKE "
      End If
      If strLogic = "=" Then
         strValue = strValue & "*"
         strLogic = " like "
      End If
      pPara = pPara & strCtlL & rstTemp("FField")

      Select Case rstTemp("FType")
      Case "Text", "Memo"

         If strLogic = "IN" Then

            varName = Split(strValue, ",")
            strTmp = ""
            For j = 0 To UBound(varName)
                  If j = 0 Then
                     strTmp = strTmp & " like  '" & varName(j) & "*' "
                  Else
                     strTmp = strTmp & " or " & rstTemp("FField") & " like  '" & varName(j) & "*' "
                  End If
            Next
            'strTmp = Left(strTmp, Len(strTmp) - 1)
            strValue = strTmp
            strLogic = " IN "
            pPara = pPara & strTmp
         Else
            pPara = pPara & strLogic & " '" & strValue & "'"
         End If

      Case "Longint", "Int", "Double", "Currency", "Boolean", "Autoid"

         If strLogic = "IN" Then

            varName = Split(strValue, ",")
            strTmp = ""
            For j = 0 To UBound(varName)
                  strTmp = strTmp & varName(j) & ","
            Next
            strTmp = left(strTmp, Len(strTmp) - 1)
            strValue = strTmp
            strLogic = " IN "
            pPara = pPara & strLogic & "(" & strValue & ")"
         Else
            pPara = pPara & strLogic & strValue
         End If

      Case "Date"

         If strLogic = "IN" Then

            varName = Split(strValue, ",")
            strTmp = ""
            For j = 0 To UBound(varName)
                  varName(j) = "20" & left(varName(j), 2) & "/" & Mid(varName(j), 3, 2) & "/" & right(varName(j), 2)
                  strTmp = strTmp & "'" & varName(j) & "',"
            Next
            strTmp = left(strTmp, Len(strTmp) - 1)
            strValue = strTmp
            strLogic = " IN "
            pPara = pPara & strLogic & "(" & strValue & ")"
         Else
            If rstTemp("FValue") <> "当天" Then
                  strValue = "20" & left(strValue, 2) & "/" & Mid(strValue, 3, 2) & "/" & right(strValue, 2)

                  pPara = pPara & strLogic & " '" & strValue & "' "
            Else
                  pPara = pPara & strLogic & " '" & Date & "' "
            End If
         End If
      End Select

      rstTemp.MoveNext
Loop
If pPara = "" Then pPara = " true "
'CurrentProject.Application.Forms(rstrFrmName).Tag = pPara
gt_GetDefaultFilter = pPara
End Function

作者: Henry D. Sy 时间: 2012-5-12 14:12
坐个沙发

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)