Curso de Microsoft Access avanzado → Curs d'Access avançat 2007

  1. Alternar el color de las filas en un informe de MS-Access
  2. Calendario para cambiar las fechas en MS-Access
  3. Creación de filtros con MS-Access
  4. Rellenar una plantilla de MS-Word a partir de una consulta en MS-Access


Buscar

Categorías

Histórico



Asociación de Internautas
Navega a la última con Firefox

4) Rellenar una plantilla de MS-Word a partir de una consulta en MS-Access
Francisco 25-05-05
Programación : Ofimática : Curs d'Access avançat 2007
Texto

Se trata de realizar un informe de MS-Access utilizando MS-Word. Crearemos un nuevo documento de MS-Word con los datos provenientes de una tabla de MS-Access. Ofrecemos dos soluciones: la primera es una solución básica y la segunda solución es capaz de rellenar una tabla de detalles, o incluso varias tablas de detalles.

Solución básica

  1. Creamos en MS-Word una plantilla, puede ser una carta, o un fax o un documento que luego vamos a imprimir en PDF. Para poner un campo ponemos el nombre del campo entre corchetes, por ejemplo [telefono]. Luego lo guardamos como plantilla (con extensión .dot) en la misma carpeta donde se encuentra nuestra base de datos.
  2. En MS-Access insertarmos en un módulo el código indicado en el apartado "Código fuente, ModuloInformeWord". De esta forma tendremos la función InformeWord lista para ser usada. Esta función tiene tres parámetros:
    ParámetroDescripciónEjemplo
    plantilla_wordEs el nombre del archivo de plantilla que hemos creado."informe_cliente.dot"
    consultaEs el nombre de una tabla o consulta. También puede ser una sentencia SQL."tabla_clientes"
    filtroSe utiliza para mostrar sólo un registro de la tabla o consulta."cliente_id=" & [cliente_id]
  3. En un formulario insertamos un botón y en su evento onClick (al hacer click) insertamos una llamada a la función:
    Al hacer clic:=InformeWord("informe_cliente.dot"; "tabla_clientes"; "cliente_id=" & [cliente_id])
    [cliente_id] es el nombre de un cuadro combinado independiente que se utiliza para seleccionar el cliente deseado.
  4. Al apretar el botón crea un documento Word nuevo basado en la plantilla que hemos creado con los campos entre corchetes sustituidos por los valores correspondientes de la tabla

Solución con tablas de detalles

  • Agregaremos el módulo de clase que se indica en el apartado "código fuente" para así disponer de la clase ClaseInformeWord
  • Según se muestra en la imagen de ejemplo la plantilla tiene un encabezado y un detalle. Los datos del encabezado provienen de la "tabla_clientes" y los datos del detalle provienen de la consulta "consulta_pedidos". El código a ejecutar para crear el informe a partir de la plantilla es el siguiente:

Private Sub ComandoInformePedidosClliente_Click()

    Dim informe As New ClaseInformeWord
    Dim filtro As String
    
    filtro = "cliente_id=" & Me.cliente_id
    
    Call informe.Abrir("informe_cliente_pedidos.dot")
    Call informe.Ejecutar("tabla_clientes", filtro)
    Call informe.EjecutarTablaDetalles(2, "consulta_pedidos", filtro)
    Call informe.Cerrar
    
    Set informe = Nothing
End Sub
En el ejemplo se supone que en el formulario hay un cuadro combinado independiente llamado "cliente_id" que se utiliza para realizar el filtro. También suponemos que la segunda tabla de la plantilla MS-Word contiene el detalle de los pedidos.

Métodos de la clase: ClaseInformeWord

  • Abrir - Inicia el proceso abriendo la plantilla de MS-Word
    ParámetroDescripciónEjemplo
    plantilla_wordNombre de la plantilla MS-Word. Se ha de encontrar en la misma carpeta que la base de datos"fax_cliente.dot"
  • Cerrar - Finaliza el proceso y muestra el documento creado
  • Ejecutar - Sustituye los campos entre corchetes de la plantilla por los valores del primer registro de la tabla o consulta indicados.
    ParámetroDescripciónEjemplo
    consultaNombre de la tabla o consulta de MS-Access"tabla_clientes"
    filtroFiltro aplicado sobre la tabla o consulta. Habitualmente se filtra sobre el campo ID clave principal"cliente_id=" & [cliente_id]
  • EjecutarTablaDetalles - Sustituye los campos entre corchetes de la tabla de detalles indicada en la plantilla MS-Word. Además añade tantas filas a dicha tabla como sean necesarias para mostrar todos los registros de la tabla o consulta indicados.
    ParámetroDescripciónEjemplo
    num_tablaSe utiliza para identificar la tabla de detalle de la plantilla MS-Word. Si la plantilla MS-Word tiene, por ejemplo, cinco tablas en total y la tabla de detalles es la tercera, entonces tendríamos que indicar un 3.3
    consultaNombre de la tabla o consulta de MS-Access"consulta_pedidos"
    filtroFiltro aplicado sobre la tabla o consulta. Habitualmente se filtra sobre el campo ID clave principal"cliente_id=" & [cliente_id]

Código fuente

"ModuloInformeWord"

Incluir el siguiente código en un nuevo módulo de la base de datos que se llame por ejemplo ModuloInformeWord:


'REFERENCIAS NECESARIAS:
'Menú -> Herramientas -> Referencias -> Microsoft Word Object Library
Public Function InformeWord( _
  ByVal plantilla_word As String, _
  ByVal consulta As String, _
  Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
'Ejemplo de uso (evento al hacer clic de un botón de comando):
'=InformeWord("informe_cliente.dot";"tabla_clientes";"cliente_id=" & cliente_id)

    Dim rs As DAO.Recordset
    Dim campo As DAO.Field
    Dim appWord As Word.Application
    Dim documento_word As Word.Document
    Dim ruta_actual As String
    
    If filtro <> "" Then
        consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
    End If
    Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
    
    If rs.BOF And rs.EOF Then
        'Nada
    Else
    
        Set appWord = New Word.Application
        appWord.Visible = False
        Call SysCmd(acSysCmdInitMeter, "Exportando a Word", 100)
        DoCmd.Hourglass True
        
        If plantilla_word = "" Then
            Set documento_word = appWord.Documents.Add()
        Else
            ruta_actual = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
            Set documento_word = appWord.Documents.Add(ruta_actual & plantilla_word)
        End If
        
        For Each campo In rs.Fields
        
            With appWord.Selection.Find
                .ClearFormatting
                .Text = "[" & UCase(campo.Name) & "]"
                With .Replacement
                    .ClearFormatting
                    .Text = rs(campo.Name) & ""
                End With
                Call .Execute(Replace:=Word.WdReplace.wdReplaceAll)
            End With
            
        Next
    
    End If
    InformeWord = True
Salida:
On Error Resume Next
    appWord.Visible = True
    Call SysCmd(acSysCmdRemoveMeter)
    DoCmd.Hourglass False
    Set appWord = Nothing
    Set documento_word = Nothing
    rs.Close: Set rs = Nothing
    Set campo = Nothing
    Exit Function
Errores:
    MsgBox Err.Description, vbCritical, "InformeWord"
    Resume Salida
End Function

Módulo de clase "ClaseInformeWord"


Option Compare Database
Option Explicit

'REFERENCIAS NECESARIAS:
'Menú -> Herramientas -> Referencias -> Microsoft Word Object Library

'Ejemplo:
'' Dim informe As New ClaseInformeWord
'' Dim filtro As String
''
'' filtro = "cliente_id=" & Me.cliente_id
''
'' Call informe.Abrir("informe_cliente_pedidos.dot")
'' Call informe.Ejecutar("tabla_clientes", filtro)
'' Call informe.EjecutarTablaDetalles(2, "consulta_pedidos", filtro)
'' Call informe.Cerrar
''
'' Set informe = Nothing

Private app_word As Word.Application
Private documento_word As Word.Document
Private Sub Class_Initialize()
    'Nada
End Sub
Private Sub Class_Terminate()
    Call Cerrar
End Sub
Public Function Abrir(ByVal plantilla_word As String)
    Dim ruta_actual As String

    Set app_word = New Word.Application
    app_word.Visible = False
    
    If plantilla_word = "" Then
        Set documento_word = app_word.Documents.Add()
    Else
        ruta_actual = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
        Set documento_word = app_word.Documents.Add(ruta_actual & plantilla_word)
    End If
End Function
Public Function Cerrar()
On Error Resume Next
    app_word.Visible = True
    Set app_word = Nothing
    Set documento_word = Nothing
End Function
Public Function Ejecutar( _
  ByVal consulta As String, _
  Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
    Call SysCmd(acSysCmdInitMeter, "Exportando a Word: " & consulta, 100)
    DoCmd.Hourglass True

    Dim rs As DAO.Recordset
    Dim field As DAO.field
    
    If filtro <> "" Then consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
    Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
    
    If rs.BOF And rs.EOF Then
        'Nada
    Else
        For Each field In rs.Fields
            With app_word.Selection.Find
                .ClearFormatting
                .Text = "[" & UCase(field.Name) & "]"
                With .Replacement
                    .ClearFormatting
                    .Text = rs(field.Name) & ""
                End With
                Call .Execute(Replace:=Word.WdReplace.wdReplaceAll)
            End With
        Next
    End If
    Ejecutar = True
Salida:
    Call SysCmd(acSysCmdRemoveMeter)
    DoCmd.Hourglass False
    Exit Function
Errores:
    MsgBox Err.Description, vbCritical, "Ejecutar"
    Resume Salida
End Function
Public Function EjecutarTablaDetalles( _
  ByVal num_tabla As Integer, _
  ByVal consulta As String, _
  Optional ByVal filtro As String = "" _
) As Boolean
On Error GoTo Errores
    Call SysCmd(acSysCmdInitMeter, "Exportando a Word: " & consulta, 100)
    DoCmd.Hourglass True

    Dim rs As DAO.Recordset
    Dim field As DAO.field
    Dim tabla As Word.Table
    Dim ultima_fila As Word.Row, nueva_fila As Word.Row
    Dim celda As Word.Cell
    Dim campo As String, valor As String
        
    If filtro <> "" Then consulta = "SELECT * FROM " & consulta & " WHERE " & filtro
    Set rs = CurrentDb.OpenRecordset(consulta, dbOpenForwardOnly)
    Set tabla = documento_word.Tables(num_tabla)
    
    If rs.BOF And rs.EOF Then
        'Nada
    Else
        Do Until rs.EOF
            Set ultima_fila = tabla.Rows(tabla.Rows.Count)
            Set nueva_fila = tabla.Rows.Add
            For Each celda In ultima_fila.Cells
                'Duplicar la última fila en la nueva
                campo = celda.Range.Text
                campo = Left(campo, Len(campo) - 2) 'Eliminar vbCrLf del final
                nueva_fila.Cells(celda.ColumnIndex).Range.Text = campo
                
                'Poner los valores
                For Each field In rs.Fields
                    If 0 <> InStr(LCase(field.Name), "importe") Then
                        valor = Format(Nz(rs(field.Name), 0), "#,##0.00")
                    Else
                        valor = rs(field.Name) & ""
                    End If
                    campo = Replace(campo, "[" & field.Name & "]", valor)
                Next
                celda.Range.Text = campo
            Next
            
            'Call SysCmd(acSysCmdUpdateMeter, rs.PercentPosition) 'Fallas porque es dbOpenForwardOnly
            rs.MoveNext
        Loop
    End If
    
    'Borrar la última fila
    tabla.Rows(tabla.Rows.Count).Delete
    
    EjecutarTablaDetalles = True
Salida:
    Call SysCmd(acSysCmdRemoveMeter)
    DoCmd.Hourglass False
    Exit Function
Errores:
    MsgBox Err.Description, vbCritical, "EjecutarTablaDetalles"
    Resume Salida
End Function

Aviso: Para que funcione el módulo hay que incluir una referencia a la biblioteca de clases de Microsoft Word
Menú del módulo → Herramientas → Referencias → Microsoft Word Object Library




7 comentarios:

1 → Pablo (no registrado) dice hace 9 meses:

Funciona bien cuando los marcadores no están el encabezado o pie del documento.
¿Hay forma de solucionarlo?

Un saludo

2 → expomiaoptiff (no registrado) dice hace 9 meses:

I’d prefer reading in my native language, because my knowledge of your languange is no so well. But it was interesting!

3 → Carlos Colombia (no registrado) dice hace 8 meses:

Esta muy Buena tu explicacion... Pero tengo una pregunta... puedo crear ul filtro como la busqueda del winamp?? es decir que mientras escribo automaticamente me vaya filtrando enseguida???? Se puede???? Gracias....
carlosandresardila(arroba)gmail(punto)com Gracias....

4 → jose (no registrado) dice hace 6 meses:

Muchas gracias por tu generosa contribución me fue muy utíl

5 → Lourdes (no registrado) dice hace 4 meses:

Hola, agradezco mucho la información, me esta ayudando muchisimo. Gracias.

Pero tengo un problemilla al intentar ejecutarlo en mi base de datos. Caundo le doy al boton me sale un pantallazo de error del Informeword que dice: "El parametro de la cadena es demasiado largo".
Además con la curiosidad de que en el dot. se me vuelcan unos campos y otros no ¿?.

Agradecería que me indicarais cual es mi error (estoy un poco pez en VB) ya que llevo mucho tiempo detras de esto y que ahora gracias a ti ya sale .... a medias.

Grascias Mil.

6 → Laura Domínguez (no registrado) dice hace 3 meses:

Mil gracias!! por este código, me sirvio muchísimo, era exactamente lo que buscaba. Un abrazo.

7 → Jose Sanchez (no registrado) dice hace 3 meses:

Muchisima gracia por estos codigo, deberian existir mas personas como tu, asi, lo que estamos empezado en este mundo de la informatica, encontraramos el conocimiento mas rapido

Añade tu comentario:

(El correo no será publicado)