http://proinf.net/permalink/rellenar_una_plantilla_de_ms-word_a_partir_de_una_consulta_en_ms-access
Fecha: 25-05-05, Autor: Francisco, Categoría: Programación, Ofimática
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.
.dot) en la misma carpeta donde se encuentra nuestra base de datos.InformeWord lista para ser usada. Esta función tiene tres parámetros:
| Parámetro | Descripción | Ejemplo |
|---|---|---|
| plantilla_word | Es el nombre del archivo de plantilla que hemos creado. | "informe_cliente.dot" |
| consulta | Es el nombre de una tabla o consulta. También puede ser una sentencia SQL. | "tabla_clientes" |
| filtro | Se utiliza para mostrar sólo un registro de la tabla o consulta. | "cliente_id=" & [cliente_id] |
| Al hacer clic: | =InformeWord("informe_cliente.dot"; "tabla_clientes"; "cliente_id=" & [cliente_id]) |
|---|
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.
| Parámetro | Descripción | Ejemplo |
|---|---|---|
| plantilla_word | Nombre de la plantilla MS-Word. Se ha de encontrar en la misma carpeta que la base de datos | "fax_cliente.dot" |
| Parámetro | Descripción | Ejemplo |
|---|---|---|
| consulta | Nombre de la tabla o consulta de MS-Access | "tabla_clientes" |
| filtro | Filtro aplicado sobre la tabla o consulta. Habitualmente se filtra sobre el campo ID clave principal | "cliente_id=" & [cliente_id] |
| Parámetro | Descripción | Ejemplo |
|---|---|---|
| num_tabla | Se 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 |
| consulta | Nombre de la tabla o consulta de MS-Access | "consulta_pedidos" |
| filtro | Filtro aplicado sobre la tabla o consulta. Habitualmente se filtra sobre el campo ID clave principal | "cliente_id=" & [cliente_id] |
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
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:
Hola a todos,
Quería plantearos varias dudas sobre este ejercicio. En la solución básica, me da un error de que falta operadores, pero primero os cuento yo pretendo utilizar como consulta una consulta de parametros y que el parametro metido funcione como filtro. El campo que yo utilizo es un campo numérico.
Llevo dos días dandole vueltas al tema, de como poner un botón en un formulario que me abra una consulta de parametro yo introduzco un codigo numerico y se me abre un documento en word con los datos vinculados a cada codigo.
Espero sugerencias
Hola esta excelente tu material, pero me han surgido algunos problemas, seria mucho pedir si colocaras el ejemplo en forma completa para poder bajarlo, como para tener a modo de ejemplo y asi poder chequear en que tamos haciendo mal, xq hasta ahora no he podido salir del pantana, con algo q estoy haciendo y que quiero mostrar impreso, desde ya agradesco la ayuda q me has brindado igual sigo investigando. Saludos.
Al momento he revisado el código de tu ejercicio y me parece genial pero al momento de querer aplicarlo a mi necesidad me salta el error 3464 que se refiere a que los campos no coinciden en el tipo, en este caso he pensado que tal vez mis tablas son demasiado grandes, sin embargo no puedo omitir ningún campo de ellas. Has tenido este problema? quisa me puedas dar luces para superar el inconveniente.De antemano muchas gracias por tu ayuda.Saludos
Me parecio muy interesante tu propuesta
pero al parecer tengo un error o mas bien una duda si es te codigo es general para cualkier BD al q se lo implemente o simplemente tienen q tener la misma estructura q tu manejas en tu BD ejemplo si es asi podrias darme una ayudadita con siertas partes del codigo para q pueda amoldarlo a mis necesidades
de antema gracias !!!!
Buenas tardes,
He utilizado tu ejemplo y funciona perfectamente! Muchas gracias por compartirlo.
Ahora tengo una pregunta... Es posible adaptar este mismo procedimiento para Excel?
Seria posible?
Muchas gracias!
Gracias por este material.
Funciona perfectamente pero tengo un pequeño problema:
Trabajando con campos memo, cuando se excede de los 255 carácteres salta el error "El parámetro de la cadene es demasiado largo".
¿Se puede solucionar de alguna forma?
Gracias
Tienes razón Ramón.
Si el campo es muy largo no funciona. Hay otro método alternativo que se podría seguir y sería mediante marcadores de Word. Pero este código no lo tengo y no sé si tendría el mismo problema.
Saludos