Option Compare Database
Option Explicit
' Funciones que reemplazan la palabra
' "Formularios!" por "Forms!" en Tablas,
' consultas, formularios e informes
' y sus controles.
' Necesita ser referenciada la librería
' Microsoft DAO (x.x) Object Library.
' Espero que os sea de utilidad.
'
' Julio 2002
' Juan M. Afan de Ribera - happy
' **************************************

'Tablas: Búsqueda en las propiedades de
'campo - Valor predeterminado - Regla de
'validación y Origen de la fila
Function ReemplazarenTablas()
Dim tdf As TableDef
Dim fld As Field
Dim prp As Property
For Each tdf In CurrentDb.TableDefs
For Each fld In tdf.Fields
For Each prp In fld.Properties
If prp.Name = "DefaultValue" Or prp.Name = "ValidationRule" Or prp.Name =
"RowSource" Then
prp.Value = Traduccion(prp.Value)
End If
Next
Next
Next
End Function
'Consultas: Búsqueda en la cadena sql
Function ReemplazarenConsultas()
Dim qdf As QueryDef
For Each qdf In CurrentDb.QueryDefs
qdf.SQL = Traduccion(qdf.SQL)
Next
End Function
'Formularios: Búsqueda en el Origen del
'Registro y Filtro. Controles: Búsqueda
'en el Origen del Control y Origen de la
'Fila
Function ReemplazarenFormularios()
Dim obj As AccessObject
Dim frm As Form
Dim ctl As control
Dim prp As Property
For Each obj In CurrentProject.AllForms
DoCmd.OpenForm obj.Name, acDesign, , , , acIcon
Set frm = Forms(obj.Name)
frm.RecordSource = Traduccion(frm.RecordSource)
frm.Filter = Traduccion(frm.Filter)
For Each ctl In frm.Controls
For Each prp In ctl.Properties
If prp.Name = "RecordSource" Or prp.Name = "RowSource" Then
prp.Value = Traduccion(prp.Value)
Debug.Print prp.Value
End If
Next
Next
Set frm = Nothing
DoCmd.Close acForm, obj.Name, acSaveYes
Next
End Function
'Informes: Búsqueda igual que en formularios
Function ReemplazarenInformes()
Dim obj As AccessObject
Dim rpt As Report
Dim ctl As control
Dim prp As Property
For Each obj In CurrentProject.AllReports
DoCmd.OpenReport obj.Name, acViewDesign
DoCmd.Minimize
Set rpt = Reports(obj.Name)
rpt.RecordSource = Traduccion(rpt.RecordSource)
rpt.Filter = Traduccion(rpt.Filter)
For Each ctl In rpt.Controls
For Each prp In ctl.Properties
If prp.Name = "ControlSource" Or prp.Name = "RowSource" Then
prp.Value = Traduccion(prp.Value)
End If
Next
Next
Set rpt = Nothing
DoCmd.Close acReport, obj.Name, acSaveYes
Next
End Function
Function Traduccion(Cadena As String)
Traduccion = Replace(Cadena, "Formularios!", "Forms!")
End Function