Rellenar plantilla en Word desde formulario access con un boton

[jcmhermida]

� Hola !
Tengo el siguiente c�digo en Visual Basic para rellenar una plantilla en
Word y la tabla de detalles me genera las filas necesarias para los registros
filtrados pero en cada fila me repite siempre los mismos datos. Que tengo que
modificar en el c�digo para que me cambio los datos en la tabla de word

codigo:

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

Muchas gracias por adelantado