¡Hola nuevamente! En esta ocasión seguiremos interactuando con Word y lo que toca hacer es enviar, nuevamente, datos, pero ya no una tabla completa sino, datos específicos a cajas de texto en el archivo de Word, como si fuera un reporte y Excel nuestra base de datos. Para mí es más práctico usar la herramienta “Combinar correspondencia” desde el mismo Word, pero sé que para muchos es mejor hacer todo desde Excel, así que, manos a la obra.
Lo primero es tener datos, por ejemplo, del siguiente modo:
Ojo que en la celda B1 hay una lista desplegable de los datos de la columna “Id” de la Tabla (Asumo que saben cómo hacerla).
En Word tendremos un documento así:
Por si no lo saben, aquellas partes del Word en donde dice “Haga clic o pulse aquí para escribir texto”, cada uno es un “Control de contenido de texto sin formato” que serán los campos en donde insertemos el texto que tenemos en Excel. Para usarlos, activen la pestaña “Programador” de su Word y en el grupo “Controles” los encontrarán.
Para que sea fácil su identificación en el archivo Word vamos a modificar la propiedad “Título” de cada control, no será difícil si vamos seleccionado cada uno y presionamos el botón “Propiedades” del mismo grupo “Controles” y agregamos el título que elijamos.
En mi caso elegí TxtId, TxtNombres, TxtSexo, etc.
Ahora sugiero releer un par de artículos sobre las referencias a activar y el objeto Word (Enlace1) y otro sobre cómo detectar archivos abiertos (Enlace2). Del segundo enlace copiaremos en nuestro archivo Excel la UDF “IsFileOpen”.
Luego vamos a declarar las variables y abrir el archivo Word al que enviaremos los datos. Ya que enviaremos solo un registro a la vez, es importante que previamente se haya elegido un dato en la lista desplegable de la celda B1..
If Range("B1") = "" Then
MsgBox "Elija un dato de la lista", vbOKOnly, "Todo Sobre Excel"
Exit Sub
End If
strArchivo = ThisWorkbook.Path & "\Formulario de datos.docx"
If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo", vbOKOnly, "Todo Sobre Excel"
Exit Sub
End If
If IsFileOpen(strArchivo) Then
'si está abierto el archivo word
Set objDoc = GetObject(strArchivo)
Set MiappWord = objDoc.Application
Else
'si está cerrado el archivo Word
Set MiappWord = CreateObject("Word.Application")
MiappWord.Documents.Open strArchivo
MiappWord.Visible = True
End If
Algo que no hicimos al inicio es declarar las variables que usaremos para los datos que enviaremos a Word. Asimismo, como en Excel nuestros datos están como Tabla, declararemos una variable para dicha tabla. En un momento veremos para qué es todo eso
Dim strNombre$, strSexo$, strDireccion$, strPrograma$
Dim FechaN as Date
Dim MiTabla as ListObjects
Para hallar los valores que corresponda al ID que elijamos en la celda B1, vamos a usar la WorkSheetFunction llamada VlookUp, de funcionamiento similar a BuscarV. Yo prefiero usar Find, pero para el ejercicio considero que será más fácil entender la función elegida. Esos sí, como buscaremos los datos en una Tabla, primero asignaremos el objeto Tabla a la variable respectiva y ya después usaremos el VLookUp.
Set miTabla = Hoja1.ListObjects("Tabla1")
With Application.WorksheetFunction
strnombre = .VLookup(Range("B1"), miTabla.Range, 2, 0)
strsexo = .VLookup(Range("B1"), miTabla.Range, 3, 0)
fechan = .VLookup(Range("B1"), miTabla.Range, 4, 0)
strdireccion = .VLookup(Range("B1"), miTabla.Range, 5, 0)
strprograma = .VLookup(Range("B1"), miTabla.Range, 6, 0)
End With
Como ya tenemos los valores en nuestras variables, ahora sí comenzaremos a trabajar con el objeto Word y con los controles que ahí tenemos. Como vamos a trabajar con el documento activo, y hemos colocado nuestros propios títulos a cada control de nuestro archivo Word, usaremos también el método SelectContentControlsByTitle así como el objeto Range del control, que representa su área continua. Por último, a través de la propiedad Text le daremos el valor de nuestras variables de Excel. Ah, ojo con los nombres de los títulos de los controles ya que son sensibles a mayúsculas y minúsculas. El resultado en Word debe verse así:
Juntando todo y ordenando, deberíamos tener esto:
Option Explicit
'Todo Sobre Excel
'Abraham Valencia
'https://abrahamexcel.blogspot.com/
'https://www.facebook.com/TodosobreExcelAV/
'https://twitter.com/Todosobre_Excel
'Lima, Perú
'Julio del 2020
Sub EnviarDatosaWord()
Dim MiappWord As Word.Application
Dim objDoc As Object
Dim strArchivo$, strnombre$, strsexo$, strdireccion$, strprograma$
Dim fechan As Date
Dim miTabla As ListObject
If Range("B1") = "" Then
MsgBox "Elija un dato de la lista", vbOKOnly, "Todo Sobre Excel"
Exit Sub
End
If strArchivo = ThisWorkbook.Path & "\Formulario de datos.docx" If Dir(strArchivo) = "" Then
MsgBox "No existe el archivo", vbOKOnly, "Todo Sobre Excel"
Exit Sub
End If
Set miTabla = Hoja1.ListObjects("Tabla1")
With Application.WorksheetFunction
strnombre = .VLookup(Range("B1"), miTabla.Range, 2, 0)
strsexo = .VLookup(Range("B1"), miTabla.Range, 3, 0)
fechan = .VLookup(Range("B1"), miTabla.Range, 4, 0)
strdireccion = .VLookup(Range("B1"), miTabla.Range, 5, 0)
strprograma = .VLookup(Range("B1"), miTabla.Range, 6, 0)
End With
If IsFileOpen(strArchivo) Then
'si está abierto el archivo word
Set objDoc = GetObject(strArchivo)
Set MiappWord = objDoc.Application
Else
'si está cerrado el archivo Word
Set MiappWord = CreateObject("Word.Application")
MiappWord.Documents.Open strArchivo
MiappWord.Visible = True
End If
With MiappWord.ActiveDocument
.SelectContentControlsByTitle("TxtId").Item(1).Range.Text = Hoja1.Range("B1").Value
.SelectContentControlsByTitle("TxtNombres").Item(1).Range.Text = strnombre
.SelectContentControlsByTitle("TxtSexo").Item(1).Range.Text = strsexo
.SelectContentControlsByTitle("TxtFechaN").Item(1).Range.Text = fechan
.SelectContentControlsByTitle("TxtDirección").Item(1).Range.Text = strdireccion
.SelectContentControlsByTitle("TxtPrograma").Item(1).Range.Text = strprograma
.SelectContentControlsByTitle("TxtFechaI").Item(1).Range.Text = Date
End With
'Dejamos el cursor al final de la página
MiappWord.Selection.EndKey Unit:=wdStory
MsgBox "Todo listo", vbOKOnly, "Todo Sobre Excel"
'Esta línea no es necesaria, pero por costumbre algunos la usamos
Set MiappWord = Nothing
End Sub
Y listo, eso es todo por hoy. Ah, por supuesto que si quieren pueden mejorar el formato del Word, al ser este un ejemplo pues no le dedico tiempo a ese tipo de detalles ¡Hasta la próxima!
Abraham Valencia
Lima, Perú
Descargue el ejemplo de aquí
Excelente explicación Excel - Word!!. Como sería el caso en que quisiéramos crear en formato de extensión .rtf?
ResponderBorrarHola, los archivos *.rtf son generados al usar "Guardar como", entonces, si quisieramos hacer eso para el ejemplo del artículo, deberíamos agregar una línea como esta al final: MiappWord.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Path & "\miarchivo.rtf", FileFormat:=wdFormatRTF
Borraresta buena la idea. gracias
ResponderBorrar