Requerimiento previo, incluir en el menú Herramientas -> Referencias
la de "Microsoft Word X.X Object Library"
En la plantilla deberás insertar "marcadores" que serán sustituidos
cuando se ejecute el procedimiento por el contenido del campo en la
base de datos.
En el procedimiento se hace uso tanto del "nombre" del marcador, como
del nombre del cuadro de texto del formulario.
-------------Inicio de copia del
procedimiento-------------------------------
Private Sub CmdCombinar_Click()
On Error GoTo Err_cmdCombinar
Dim AppWord As Word.Application
Dim DocWord As Word.Document
Dim Resp As Long
'
' Variable con el nombre completo del fax a guardar.
'
Dim FileName As String
'
'Variable en la que se tiene u obtiene el nombre de la plantilla.
'
Dim Plantilla As String
'
' Variable en la que se tiene u obtiene el nombre del directorio de
los fax.
'
Dim DirFax As String
Plantilla = "C:\Plantillas\Plantilla.dot"
DirFax = "C:\Faxes\
'
' Abrir el Word utilizando la plantilla.
'
AppWord.Documents.Add Template:=Plantilla, NewTemplate:=False
Set DocWord = AppWord.ActiveDocument
'
' Comprobar existencia de un marcador llamado 'PersonaContacto', si
existe
' y el contenido del cuadro de texto del formulario no es nulo se
introduce
' en el documento.
If DocWord.Bookmarks.Exists("PersonaContacto") Then
If Not IsNull(PersonaContacto) Then
DocWord.Bookmarks("PersonaContacto").Select
Texto = PersonaContacto
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("CabeceraFax") Then
If Not IsNull(CabeceraFax) Then
DocWord.Bookmarks("CabeceraFax").Select
Texto = CabeceraFax
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("Fax") Then
If Not IsNull(Fax) Then
DocWord.Bookmarks("Fax").Select
Texto = Fax
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("Remite") Then
If Not IsNull(Remite) Then
DocWord.Bookmarks("Remite").Select
Texto = Remite
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("Remite2") Then
If Not IsNull(Remite) Then
DocWord.Bookmarks("Remite2").Select
Texto = Remite
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("Direccion1") Then
If Not IsNull(Direccion1) Then
DocWord.Bookmarks("Direccion1").Select
Texto = Direccion1
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("Direccion2") Then
If Not IsNull(Direccion2) Then
DocWord.Bookmarks("Direccion2").Select
Texto = Direccion2
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("Tlf") Then
If Not IsNull(Rs!Tlf) Then
DocWord.Bookmarks("Tlf").Select
Texto = Rs!Tlf
DocWord.Application.Selection.TypeText Text:=Texto
End If
End If
If DocWord.Bookmarks.Exists("FechaFax") Then
DocWord.Bookmarks("FechaFax").Select
Texto = Format(Date, "dd/mm/yyyy")
DocWord.Application.Selection.TypeText Text:=Texto
End If
AppWord.Visible = True
AppWord.ActiveDocument.SaveAs FileName
AppWord.WindowState = wdWindowStateMaximize
Exit_cmdCombinar:
DoCmd.Hourglass False
Exit Sub
Err_cmdCombinar:
If Err = 91 Or Err = -2147023174 Then
Set AppWord = New Word.Application
Resume
End If
MsgBox Err & " " & Err.Description & Chr$(13) & Chr$(13) &
Plantilla
Resume Exit_cmdCombinar
End Sub
-------------------Fin del procedimiento
copiado-----------------------------
En este ejemplo el nombre que se puso a los marcadores en la plantilla
Word es el mismo que el que tenían los cuadros de texto en el
formulario pero pueden ser diferentes.
Si se necesita introducir la misma información en dos lugares
diferentes del fax, como ocurre en éste caso, debes definir dos
marcadores con dos nombres diferentes, aunque incluyas la misma
información.
No hay comentarios:
Publicar un comentario