Поиск встроенных макросов |
Автор Daniel Pineault | ||||||
15.10.2019 г. | ||||||
Я не люблю макросы. Особенно встроенные. Но довольно часто на доработку попадаются базы, в которых используются и код и встроенные макросы. Приходится исследовать каждый элемент формы отдельно, боясь что-то пропустить. И всё равно случаются ошибки. Большинство людей уже знают, что я не одобряю встроенные макросы в любом качестве. В отличие от VBA, макросы более сложны в программировании, не имеют возможности поиска, что затрудняет выполнение обновлений базы данных.
Короче говоря, недавно я работал над проектом, в котором мне нужно было провести основную очистку имен объектов, имен элементов управления ... и мне нужно было определить, где используется объект, чтобы я мог обновить их. Тогда я решил, что еще лучше, давайте найдем все встроенные макросы, чтобы я мог просто преобразовать их в обычный VBA, и тогда эта проблема больше не возникнет в будущем.
Поэтому я собрал следующую процедуру, которая проходит через все формы и отчеты базы данных и их соответствующие элементы управления, чтобы определить те, которые используют встроенные макросы. Надеюсь, это может помочь кому-то еще.
'--------------------------------------------------------------------------------------- ' Procedure : FindEmbeddedMacros ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Search Forms & Reports to locate any Embedded Macros ' The search results are printed to the immediate window ' Copyright : The following is release as Attribution-ShareAlike 4.0 International ' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/ ' Req'd Refs: Uses Late Binding, so none required ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' None ' ' Usage: ' ~~~~~~ ' ?FindEmbeddedMacros ' Call FindEmbeddedMacros ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************** ' 1 2017-01-07 Initial Release ' 2 2018-05-24 Copyright updated '--------------------------------------------------------------------------------------- Public Sub FindEmbeddedMacros() On Error GoTo Error_Handler Dim oFrm As Object Dim frm As Access.Form Dim oRpt As Object Dim rpt As Access.Report Dim ctl As Access.Control Dim prp As DAO.Property
Access.Application.Echo False Debug.Print "Search Results" Debug.Print "Object Type", "Object Name", "Control Name", "Event Name" Debug.Print String(80, "-")
'Search the forms For Each oFrm In Application.CurrentProject.AllForms DoCmd.OpenForm oFrm.Name, acDesign Set frm = Forms(oFrm.Name).Form With frm For Each prp In .Properties 'Form Properties If InStr(prp.Name, "EMMacro") > 0 Then If Len(prp.value) > 0 Then Debug.Print "Form", frm.Name, , Replace(prp.Name, "EmMacro", "") End If End If Next prp 'Form Control Properties For Each ctl In frm.Controls For Each prp In ctl.Properties If InStr(prp.Name, "EMMacro") > 0 Then If Len(prp.value) > 0 Then Debug.Print "Form", frm.Name, ctl.Name, Replace(prp.Name, "EmMacro", "") End If End If Next prp Next ctl End With DoCmd.Close acForm, oFrm.Name, acSaveNo Next oFrm
'Search the Reports For Each oRpt In Application.CurrentProject.AllReports DoCmd.OpenReport oRpt.Name, acDesign Set rpt = Reports(oRpt.Name).Report With rpt 'Report Properties For Each prp In .Properties If InStr(prp.Name, "EmMacro") > 0 Then If Len(prp.value) > 0 Then Debug.Print "Report", rpt.Name, , Replace(prp.Name, "EmMacro", "") End If End If Next prp 'Report Control Properties For Each ctl In rpt.Controls For Each prp In ctl.Properties If InStr(prp.Name, "EMMacro") > 0 Then If Len(prp.value) > 0 Then Debug.Print "Report", rpt.Name, ctl.Name, Replace(prp.Name, "EmMacro", "") End If End If Next prp Next ctl End With DoCmd.Close acReport, oRpt.Name, acSaveNo Next oRpt
Debug.Print String(80, "-") Debug.Print "Search Completed"
Error_Handler_Exit: On Error Resume Next Access.Application.Echo True If Not prp Is Nothing Then Set prp = Nothing If Not ctl Is Nothing Then Set ctl = Nothing If Not rpt Is Nothing Then Set rpt = Nothing If Not oRpt Is Nothing Then Set oRpt = Nothing If Not frm Is Nothing Then Set frm = Nothing If Not oFrm Is Nothing Then Set oFrm = Nothing Exit Sub
Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: FindEmbeddedMacros" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Sub
Источник MS Access – Find Embedded Macros Просмотров: 1130
|