Я не люблю макросы. Особенно встроенные. Но довольно часто на доработку попадаются базы, в которых используются и код и встроенные макросы. Приходится исследовать каждый элемент формы отдельно, боясь что-то пропустить. И всё равно случаются ошибки.
Но вот мне попалась статья Даниэля Пино, в которой описан способ получения списка всех встроенных макросов в базе. Думаю, она многим пригодится.
Большинство людей уже знают, что я не одобряю встроенные макросы в любом качестве. В отличие от 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
Просмотров: 1154
 Ваш коментарий будет первым |
 |
| Добавить коментарий |