Etiquetas

Entradas

Contribuye

miércoles, 19 de septiembre de 2012

llenar los campos de una plantilla de word

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: