access突齣顯示匹配的內(nèi)容
- 2019-09-04 16:21:00
- tmtony8 原創(chuàng)
- 3827
在程序中,我們希望能按篩選的條件高亮突齣顯示搜索到的符閤要求的內(nèi)容。
先選擇字段,再選擇具體的內(nèi)容。迴車卽可顯示匹配的內(nèi)容。
詳細(xì)源代碼:
Private Const conMod = "Form_frmSearchHighlight" 'For error handler. Private Sub cboField_AfterUpdate() On Error GoTo Err_Handler 'Purpose: Locate the display text box over the field to be searched, ' and fire the search code. 'Note: On forms where controls have different widths and heights, ' you will need to set Width and Height as well. Dim ctl As Control If Not IsNull(Me.cboField) Then 'Set ctl to the control named in the combo. Set ctl = Me(Me.cboField) 'Locate the search display on top of the control is simulates. With Me.txtSearchDisplay .Top = ctl.Top .Left = ctl.Left End With End If Call txtSearchText_AfterUpdate Exit_Handler: Set ctl = Nothing Exit Sub Err_Handler: Call LogError(Err.Number, Err.Description, conMod & ".cboField_AfterUpdate") Resume Exit_Handler End Sub Private Sub Form_Load() On Error GoTo Err_Handler 'Purpose: Initialize: clear the search text, and hide the display box. Me.txtSearchText = Null Call cboField_AfterUpdate Exit_Handler: Exit Sub Err_Handler: Call LogError(Err.Number, Err.Description, conMod & ".Form_Load") Resume Exit_Handler End Sub Private Sub txtSearchDisplay_Enter() On Error GoTo Err_Handler 'Purpose: Set focus to the real text box if the user clicks this one, ' as it cannot be edited. If Not IsNull(Me.cboField) Then Me(Me.cboField).SetFocus End If Exit_Handler: Exit Sub Err_Handler: Call LogError(Err.Number, Err.Description, conMod & ".txtSearchDisplay_Enter") Resume Exit_Handler End Sub Private Sub txtSearchText_AfterUpdate() On Error GoTo Err_Handler 'Purpose: Filter, and highlight matches in txtSearchDisplay. Dim strField As String 'The field to search Dim strSearchValue As String 'The value to find Dim strControlSource As String 'ControlSource for displaying match. Const strcWildcard = "*" 'Some other back ends use % 'HTML tags for highlighting matches. Could be just "<b>" and "</b>". Const strcTagStart = "<font color=""""red"""">" Const strcTagEnd = "</font>" 'Save any edits. If Me.Dirty Then Me.Dirty = False End If 'Apply a filter only if user chose a field and a value. If IsNull(Me.cboField) Or IsNull(Me.txtSearchText) Then If Me.FilterOn Then Me.FilterOn = False End If Call ShowHide(Me.txtSearchDisplay, False) Else strField = "[" & Me.cboField & "]" 'Cope with spaces in field name. strSearchValue = Me.txtSearchText 'Apply the filter Me.Filter = strField & " Like """ & strcWildcard & strSearchValue & strcWildcard & """" Me.FilterOn = True 'Control Source for the text box to display matches. strControlSource = "=IIf(" & strField & " Is Null, Null, " & _ "Replace(" & strField & ", """ & strSearchValue & """, """ & _ strcTagStart & strSearchValue & strcTagEnd & """))" With Me.txtSearchDisplay .ControlSource = strControlSource .Visible = True End With End If Exit_Handler: Exit Sub Err_Handler: Call LogError(Err.Number, Err.Description, conMod & "txtSearchText_AfterUpdate") Resume Exit_Handler End Sub Private Function ShowHide(ctl As Control, bShow As Boolean) On Error GoTo Err_Handler 'Purpose: Show or hide the control, moving focus if it has focus. Dim strActiveControl As String 'Name of active control on this form. Dim strSafeControl As String 'Name of a control we can set focus to. If ctl.Visible <> bShow Then 'Get the active control name. Will error in Form_Load. strActiveControl = Me.ActiveControl.Name 'Move focus if it's the one we are trying to hide. If (strActiveControl = ctl.Name) And Not bShow Then strSafeControl = Me.cboField.ItemData(0) Me(Nz(Me.cboField, strSafeControl)).SetFocus End If ctl.Visible = bShow End If Exit_Handler: Exit Function Err_Handler: 'In Form_Load, there's no active control yet, so ActiveControl.Name yields error 2474. If Err.Number = 2474& Then Resume Next Else Call LogError(Err.Number, Err.Description, conMod & ".ShowHide") Resume Exit_Handler End If End Function Private Function LogError(ByVal lngErrNumber As Long, ByVal strErrDescription As String, _ strCallingProc As String, Optional vParameters, Optional bShowUser As Boolean = True) As Boolean 'This skeleton function substitutes for the error logging function found here: MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, strCallingProc End Function
源碼蔘考自:Allen Browne的博客
分享
Access數(shù)據(jù)庫自身
- office課程播放地址及課程明細(xì)
- Excel Word PPT Access VBA等Office技巧學(xué)習(xí)平颱
- 將( .accdb) 文件格式數(shù)據(jù)庫轉(zhuǎn)換爲(wèi)早期版本(.mdb)的文件格式
- 將早期的數(shù)據(jù)庫文件格式(.mdb)轉(zhuǎn)換爲(wèi) (.accdb) 文件格式
- KB5002984:配置 Jet Red Database Engine 數(shù)據(jù)庫引擎和訪問連接引擎以阻止對(duì)遠(yuǎn)程數(shù)據(jù)庫的訪問(remote table)
- Access 365 /Access 2019 數(shù)據(jù)庫中哪些函數(shù)功能和屬性被沙箱模式阻止(如未啟動(dòng)宏時(shí))
- Access Runtime(運(yùn)行時(shí))最全的下載(2007 2010 2013 2016 2019 Access 365)
Access VBA函數(shù)模塊
- access vba代碼太長(zhǎng),換行,分行的寫法
- VB6 VBA Access真正可用併且完美支持中英文的 URLEncode 與 URLDecode 函數(shù)源碼
- 自定義VB中的urlencode函數(shù),將URL中特殊部分進(jìn)行編碼
- Access 函數(shù)簡(jiǎn)化串接sql字符串,減少符號(hào)導(dǎo)緻的書寫錯(cuò)誤
- vba完全關(guān)閉IE瀏覽器及調(diào)用IE瀏覽器的簡(jiǎn)單應(yīng)用
- 利用FollowHyperlink方法打開超鏈接提示“無法下載您要求的信息”的解決方案
- 在access中用代碼打開文本框中超鏈接地址
Access Activex第三方控件
- Activex控件或Dll 在某些電腦無法正常註冊(cè)的解決辦法(regsvr32註冊(cè)時(shí)卡?。?/a>
- office使用部分控件時(shí)提示“您沒有使用該ActiveX控件許可的問題”的解決方法
- RTF文件(富文本格式)的一些解析
- Access樹控件(treeview) 64位Office下齣現(xiàn)橫曏滾動(dòng)條不會(huì)自動(dòng)定位的解決辦法
- Access中國(guó)樹控件 在win10電腦 節(jié)點(diǎn)行間距太小的解決辦法
- EXCEL 2019 64位版(Office 2019 64位)早就支持64位Treeview 樹控件 ListView列錶等64位MSCOMMCTL.OCX控件下載
- VBA或VB6調(diào)用WebService(直接Post方式)併解析返迴的XML
Access ADP Sql Server等
- 早期PB程序連接Sqlserver齣現(xiàn)錯(cuò)誤
- MMC 不能打開文件C:/Program Files/Microsoft SQL Server/80/Tools/Binn/SQL Server Enterprise Manager.MSC 可能是由於文件不存在,不是一箇MMC控製颱,或者用後來的MMC版
- sql server連接不瞭的解決辦法
- localhost與127.0.0.1區(qū)彆
- Roych的淺談數(shù)據(jù)庫開髮繫列(Sql Server)
- sqlserver 自動(dòng)備份對(duì)備份目録沒有存取權(quán)限的解決辦法
- 安裝Sql server 2005 express 和SQLServer2005 Express版企業(yè)管理器 SQLServer2005_SSMSEE
文章分類
聯(lián)繫我們
聯(lián)繫人: | 王先生 |
---|---|
Email: | 18449932@qq.com |
QQ: | 18449932 |
微博: | officecn01 |