Vamos a ver si consigo darte una solución a tu problema (si me deja Internet, porque ayer en dos ocasiones tuve esta respuesta escrita y me quedé con dos palmos de narices ante el letrero de "Página no responde"...)
' ---------------------------------------------
En tu documento de Word pones
.... el nombre es : @TBOX01@ para efectos....
Esto te va a permitir luego sustituir esa "macro" @TBOX01@ por el contenido de un textbox o de un campo de tu base de datos...
Igualmente podrás poner otras "macros" (@TBOX02@, @TBOX03@, etc.) y hacer automáticamente las "macrosustituciones" correspondientes.
LUEGO GRABAS ESE DOCUMENTO EN FORMATO .RTF A partir de ahora tu documento se llamará "Documento.rtf", que lo va a tratar Word de forma más ágil que un .doc
' ---------------------------------------------
En tu aplicación insertas este código, para ejecutarlo por ejemplo cuando pulses un CommandButton que se llame CmdImprimirWord
Dim w As New Word.Application
Dim cFich As String, wFich As String
Private Sub CmdImprimirWord()
cFich = "NOMBRE DE TU PLANTILLA DE WORD.rtf"
wFich = "Temporal.rtf"
' Copiamos tu plantilla en otro Fichero para el Informe y no machacar la plantilla
FileCopy cFich, wFich
CambiaMacros
if Dir( cFich) <> "" then
' No hubo error al hacer las "macrosustituciones"
w.Documents.Open (wFich)
w.Caption = "MS-Word - Creando informe"
w.Visible = True
w.WindowState = wdWindowStateMaximize
Set w = Nothing
' Borro el fichero temporal de informe
Kill(wFich)
End If
End Sub
Private Function CambiaMacros()
Dim nHandle%
Dim strBuffer As String
Dim n As Long
Dim strText As String
Dim strPrem As String
Dim strPost As String
Dim cMacro As String
Dim cStrB As String
Dim cTit As String
Dim lFallo As Boolean
strText = ""
nHandle% = FreeFile
Open wFich For Input As #nHandle%
Do While Not EOF(nHandle%)
Line Input #nHandle%, strBuffer
strText = strText & strBuffer & vbCrLf
Loop
Close #nHandle%
cStrB = "@"
n = InStr(1, strText, cStrB)
do while n <> 0
If Mid(strText, n + 7, 1) = cStrB Then
cTit = ""
cMacro = UCase(Mid(strText, n, 8))
If cMacro = "@TBOX01@" Then ' Para sustituir por el primer textbox
cTit = text1.text
' Aunque también podrías sustituirlo por un campo de una tabla: cTit = Db.Tab!NombreCliente...
ElseIf cMacro = "@TBOX02@" Then ' Para sustituir por el segundo textbox
cTit = text2.text
'
' Cuantos casos precises incustar en la plantilla
'
Else
' Por si se ha incluido una "macro" mal redactada
MsgBox("Revise la Plantilla :" & Chr(10) & _
"Ha introducido como ""macro"" la palabra " & cMacro & Chr(10) & _
"y no ha diseñado la SQL de conversión para tal ""macro"".", vbCritical)
lFallo = True
Exit Do
End If
Else
n = InStr(n + 1, strText, cStrB)
End If
strPost = Mid(strText, n + 8)
strPrem = Left(strText, n - 1)
If cTit <> "" Then
strText = strPrem & cTit & strPost
' Busca si la plantilla tiene más "macros"
n = InStr(n + 9, strText, cStrB)
Else
strText = strPrem & strPost
n = InStr(n + 1, strText, cStrB)
End If
If Len(strPost) < 8 Then Exit Do
Loop
If lFallo Then
' Hubo error en una "macro"
Kill(wFich)
wFich = ""
exit Function
End If
nHandle% = FreeFile
Open wFich For Output As #nHandle%
Print #nHandle%, strText
Close #nHandle%
CmdSust.Visible = False
End Function
' --------------------------------------
Espero te vaya bonito...
Saludos y suerte
