Access de Xavi

Objetos => Formularios => Mensaje iniciado por: xavi en Abril 20, 2012, 07:11:46 pm

Título: Reemplazo masivo Formularios! por Forms!
Publicado por: xavi en Abril 20, 2012, 07:11:46 pm

Palabras clave: reemplazo, formularios, forms
Autor: Juan M. Afán de Ribera
Extraído de: La web del Búho

---

Objetivo
Reemplazar la aparición de la palabra Formularios! por Forms! en tablas, consultas, formularios e informes y sus controles

Código: [Seleccionar]

'**************************************
' Funciones que reemplazan la palabra
' "Formularios!" por "Forms!" en Tablas,
' consultas, formularios e informes
' y sus controles.
'
' Si vas a utilizar esto en Access 97
' te sugiero que descargues unas
' funciones adicionales en la dirección
'     http://tinyurl.com/bp2r
' ahí encontrarás la función Replace
' y algunas otras que te serán de
' utilidad.
'
' Fecha creación: Julio 2002
' 1º Revisión: Febrero 2003
'
' Juan M. Afan de Ribera - happy
' **************************************

Option Compare Database
Option Explicit

'Tablas: Búsqueda en las propiedades de
'campo - Valor predeterminado - Regla de
'validación y Origen de la fila

Function ReemplazarenTablas()
Dim tdf As Object 'DAO.TableDef
Dim fld As Object 'DAO.Field
Dim prp As Object 'DAO.Property

   For Each tdf In CurrentDb.TableDefs
      If Left(tdf.Name, 4) <> "MSys" Then
         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
      End If
   Next
 
End Function

'Consultas: Búsqueda en la cadena sql

Function ReemplazarenConsultas()
Dim qdf As Object 'DAO.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 = "ControlSource" Or _
            prp.Name = "RowSource" Then
               prp.Value = Traduccion(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