PROGRAMAR EN VBA MACROS PARA EXCEL: Conectar Excel con Word
Mostrando las entradas con la etiqueta Conectar Excel con Word. Mostrar todas las entradas
Mostrando las entradas con la etiqueta Conectar Excel con Word. Mostrar todas las entradas

Como Filtrar por Cliente Rango de Fechas y Exportar a WORD






En este post se muestra una como Filtrar por Cliente y Rango de Fechas y luego Exportar lo Filtrado a Word con una macro de Excel, es decir que la macro permite que se filtre por cliente si se requiere se puede adicionar un filtro por fecha, esos datos se mostrarán en un Listbox, luego presionando un botón se exportarán los datos del Listbox a un archivo de Word.

Este es otro vídeo más de la saga de vídeos que tratan el tema o muestran como Conectar Excel con Word, en el siguiente play list podrás ver el resto de vídeos relacionados con el correspondiente link para descarga del ejemplo.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.






  


El ejemplo contenido en el libro de Excel que se puede descargar desde el final del post, al iniciar se puede observar botón que presionándolo muestra un formulario con textbox para búsquedas un listbox donde se mostrarán los datos filtrados y botón para filtrar por rango de datos y lo que nos importa en este ejemplo un botón para exportar los datos filtrados a Word.

Insertando los tres primeros caracteres la macro comenzará a buscar en la base de datos de Clientes que está en la Hoja1, mostrando en el listbox todas las coincidencias que haya en la base de datos ministras se va escribiendo en el textbox, al filtro se le puede adicionar un filtro por rango de fechas, es decir primero se podrá filtrar por cliente y los registros relacionados con el cliente se le puede agregar otro filtro más por rango de fechas.

Las fechas tanto de inicio como de fin del rango se deben ingresar y luego presionar el botón destinado a aplicar un filtro por fecha desde fecha hasta, eso se hace con el primer botón que tiene como imagen un lupa, procediendo a mostrar en el listbox los datos filtrados o coincidentes con los criterios de búsqueda.

Una vez que se tienen los datos requeridos de acuerdo al filtro, presionando el botón exportar a Word, que tiene una imagen icono de Word, se pasan todos los datos filtrados y mostrados en el listbox a un archivo de Word mediante una macro.

Para logar pasar dos datos del Listbox de Excel a Word, se trabajará con una hoja temporal, para poder pasar los datos del listbox a una hoja de Excel, eso se realiza con el siguiente código

Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"

Luego se empiezan a pasar todos los datos del listbox que son los coincidentes con el filtro de datos requerido a la hoja temporal de Excel eso se realiza con la codificación que se muestra a continuación:

For x = 1 To UserForm1.ListBox1.ListCount - 5
a.Cells(x + 2, "A") = ListBox1.List(x, 0)
a.Cells(x + 2, "B") = CDate(ListBox1.List(x, 1))
a.Cells(x + 2, "C") = ListBox1.List(x, 2)
a.Cells(x + 2, "D") = ListBox1.List(x, 3)
a.Cells(x + 2, "E") = ListBox1.List(x, 4)
a.Cells(x + 2, "F") = ListBox1.List(x, 5)
a.Cells(x + 2, "G") = CDec(ListBox1.List(x, 6))
Next


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como Copiar un Gráfico de Excel a Word

Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Como buscar datos en Excel con el método Find

Posteriormente se da un poco de formato al informe, ya que se supone que lo que se requiere es crear un informe o reporte de Ventas del Cliente, desde ya esto puede servir para cualquier reporte que se requiera crear, solo basta adaptar un poco, algunos de los códigos usados son los siguientes;

a.Range("G2:G" & uf).NumberFormat = "#.#,0"
a.Range("B2:B" & uf).NumberFormat = "dd/mm/yyyy"
a.Range("A:G").Columns.AutoFit
a.Range("A:A").ColumnWidth = 31

El primero da a la celdas formato de número con separador de miles y dos decimales, el segundo código da formato de fecha, el tercer código establece que las columnas se expandan en forma automática de acuerdo al texto contenido en la celta y el cuarto código da un ancho de columna determinado.

Una vez que esté listo el informe en la hoja de Excel la macro determina el nombre con el que va a Guardar el archivo de Word, en este caso se guardará con el mismo nombre de la macro se usan los siguientes códigos:

nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
ruta = ThisWorkbook.Path & "\" & nomarch & ".docx

Posteriormente se agrega un documento Word cuyo nombre es el determinado anteriormente:

Set wdDoc = objWord.Documents.Add
nomfic = nomarch & " " & Format(Date, "dd-mm-yyyy")
rutainf = ThisWorkbook.Path & "\" & nomfic & ".docx"

Seguidamente empieza a pasar los datos de Excel a Word como: primero la macro crea un marcador en Word que le indique a donde se debe pegar la tabla de Excel, para ello tipea el nombre del marcador agregando dos párrafos, es como si se estuviera escribiendo directamente en Word, con los siguientes códigos:

tj = "[Tabla1]"
objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=tj

Luego con el método find la macro va a buscar donde está el marcador escribo en Word y lo reemplazará con la tabla que previamente ha copiado de Excel, así:

a.Range("A1:" & wc & uf).Copy

ts = "[Tabla1]"
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
Wend

Ya se han copiado los datos, en este caso una tabla de Excel a Word, ahora en Word se le va a dar formato tomando uno de los formatos que tiene estandarizados Word para las tablas,con el siguiente código:

For Each tabla In objWord.ActiveDocument.Tables
tabla.Style = "Tabla con cuadrícula 2 - Énfasis 1"
tabla.AutoFitBehavior wdAutoFitWindow
With objWord.ActiveDocument.Styles("Tabla con cuadrícula 2 - Énfasis 1").Font
 .Size = 8
 .Color = wdColorAutomatic
End With
Next

Por último Guarda el documento de Word y lo cierra, elimina la hoja temporal, sale un mensaje de finalización de la macro y está termina, logrando con macro de Excel Filtrar por Cliente por un Lapso de Fechas y Mostrando en Lsitbox el Filtro y Exportando lo Filtrado a Word.

Seguidamente el código completo y a continuación el link de descarga, sugiero descargar el archivo y ver el vídeo para una comprensión más fácil.


Código que se inserta en un Formulario de Excel

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********



Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
On Error Resume Next
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato2 = Empty Or dato1 = emtpy Then
MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO"
Exit Sub
End If
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear

'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

If dato1 = Empty Or dato2 = Empty Then

For i = 2 To uf
   dato0 = CDate(b.Cells(i, 2).Value)
   If dato0 >= dato1 And dato0 <= dato2 Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i


Else

If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If

For i = 2 To uf
   strg = b.Cells(i, 1).Value
   dato0 = CDate(b.Cells(i, 2).Value)
   If UCase(strg) Like UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i

End If


'Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets("Hoja1").Cells(1, ii + 1)
Next ii

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total Importe"

For x = 0 To UserForm1.ListBox1.ListCount - 1
t = CDec(UserForm1.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Format(tot, " ""U$S"" #,##0.00 ")

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total de registros:"
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = UserForm1.ListBox1.ListCount - 5

Me.ListBox1.ColumnWidths = "170 pt;70 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
End Sub

Private Sub CommandButton3_Click()
Unload UserForm1
End Sub

Private Sub CommandButton4_Click()
Dim objWord As Word.Application, wdDoc As Word.Document
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
Set a = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")

For x = 1 To UserForm1.ListBox1.ListCount - 5
a.Cells(x + 2, "A") = ListBox1.List(x, 0)
a.Cells(x + 2, "B") = CDate(ListBox1.List(x, 1))
a.Cells(x + 2, "C") = ListBox1.List(x, 2)
a.Cells(x + 2, "D") = ListBox1.List(x, 3)
a.Cells(x + 2, "E") = ListBox1.List(x, 4)
a.Cells(x + 2, "F") = ListBox1.List(x, 5)
a.Cells(x + 2, "G") = CDec(ListBox1.List(x, 6))
Next

a.Cells(x + 4, "A") = ListBox1.List(x + 2, 0)
a.Cells(x + 5, "A") = ListBox1.List(x + 3, 0)
a.Cells(x + 4, "B") = ListBox1.List(x + 2, 1)
a.Cells(x + 5, "B") = ListBox1.List(x + 3, 1)

a.Activate
a.Range("A1") = "REPORTE DE VENTAS"

With a.Range("A1:G1")
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.RowHeight = 20
.Font.Size = 16
End With

a.Range("A2") = "CLIENTE"
a.Range("B2") = "FECHA"
a.Range("C2") = "COMPROBANTE"
a.Range("D2") = "TIPO"
a.Range("E2") = "SUC"
a.Range("F2") = "N COMP"
a.Range("G2") = "IMPORTE"
uf = a.Range("G" & Rows.Count).End(xlUp).Row
a.Range("G2:G" & uf).NumberFormat = "#.#,0"
a.Range("B2:B" & uf).NumberFormat = "dd/mm/yyyy"
a.Range("A:G").Columns.AutoFit
a.Range("A:A").ColumnWidth = 31
Application.PrintCommunication = True
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$G$" & uf + 4
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
ruta = ThisWorkbook.Path & "\" & nomarch & ".docx"
Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
'objWord.Visible = True
Set wdDoc = objWord.Documents.Add
nomfic = nomarch & " " & Format(Date, "dd-mm-yyyy")
rutainf = ThisWorkbook.Path & "\" & nomfic & ".docx"

tj = "[Tabla1]"
objWord.Selection.TypeParagraph
objWord.Selection.TypeParagraph
objWord.Selection.TypeText Text:=tj

uf = a.Range("A" & pf).End(xlDown).Row
uc = a.Range("A1").End(xlToRight).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)

a.Range("A1:" & wc & uf).Copy

ts = "[Tabla1]"
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
Wend

Dim tabla As Table
For Each tabla In objWord.ActiveDocument.Tables
tabla.Style = "Tabla con cuadrícula 2 - Énfasis 1"
tabla.AutoFitBehavior wdAutoFitWindow
With objWord.ActiveDocument.Styles("Tabla con cuadrícula 2 - Énfasis 1").Font
 .Size = 8
 .Color = wdColorAutomatic
End With
Next

wdDoc.SaveAs Filename:=rutainf, FileFormat:=wdFormatXMLDocument
wdDoc.Close
wdDoc.Quit

a.Delete
Sheets("Hoja1").Select
MsgBox "El reporte se exportó a Word con éxito", vbCritical, "AVISO"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
   Me.ListBox1.RowSource = "Hoja1!A1:G" & uf
   Exit Sub
End If


b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem


For i = 2 To uf
   strg = b.Cells(i, 1).Value
   If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
       Me.ListBox1.AddItem b.Cells(i, 1)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = b.Cells(i, 4)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
       Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 7)
   End If
Next i



'Carga los datos de la cabecera en listbox
For ii = 0 To 7
UserForm1.ListBox1.List(0, ii) = Sheets("Hoja1").Cells(1, ii + 1)
Next ii


UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total Importe"

For x = 0 To UserForm1.ListBox1.ListCount - 1
t = CDec(UserForm1.ListBox1.List(x, 6))
tot = tot + t
t = 0
Next x
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = Format(tot, " ""U$S"" #,##0.00 ")

UserForm1.ListBox1.AddItem
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 0) = "Total de registros:"
UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = UserForm1.ListBox1.ListCount - 5


UserForm1.TextBox2 = Clear
UserForm1.TextBox3 = Clear

Me.ListBox1.ColumnWidths = "170 pt;70 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
End Sub

Private Sub TextBox2_Change()
If Len(UserForm1.TextBox2) = 10 Then UserForm1.TextBox3.SetFocus
End Sub

Private Sub TextBox3_Change()
If Len(UserForm1.TextBox3) = 10 Then UserForm1.CommandButton2.SetFocus
End Sub

Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Hoja1")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
    .ColumnCount = 7
    .ColumnWidths = "170 pt;50 pt;50 pt;50 pt;50 pt;50 pt;50 pt"
    .RowSource = "Hoja1!A1:" & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
End Sub


Código que se inserta en un módulo

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********

Sub muestra1()
UserForm1.Show
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como Copiar Varias Tablas Vinculadas de Excel a Word de Distintas Hojas






A pedido de un suscriptor de nuestro canal de YouTube se presenta este ejemplo de macro muestra como exportar las tablas de todas las hojas de Excel a Word en forma vinculadas, es decir la macro recorrerá todas las hojas del libro de Excel, determinará en forma automática el rango de cada unas de las tablas contenidas en cada una de las hojas, las copiará y pegara en Word.

Recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.






 


En el libro que se puede descargar desde el final, el cual es un fichero comprimido que contiene el archivo de Excel con la Macro y un archivo de Word que es usado como plantilla; al abrirlo se puede observar que el libro Excel cuenta con varias hojas, dentro de cada hoja existen diferentes tablas, estas tablas tiene como estructura común que se encuentran que todas empiezan en la columna A y que se encuentran separadas por dos filas vacías, es a los fines que la macro pueda determinar en forma automática el rango de cada una de las tablas las copie y pegue en Word.

La macro se ejecuta con el botón que se encuentra en la hoja1 del libro, al presionarla recorre cada una de las hojas del libro Excel buscando las tablas y copiando y pegando las miasmas a Word, el archivo de Word es una plantilla que simula un informe que contiene un marcador que le dice a la macro donde debe ir pegada cada tabla.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como sumar datos seleccionados en un listbox multiselect


Como insertar filas en hojas de Excel

Libro de Excel con link a todas las macros y tutoriales en YouTube con buscador







La macro recorre todas las hojas del libro Excel en busca de las tablas, para recorrer hojas se utiliza el siguiente código:

For Each hoja In Worksheets

Para que la macro determine en forma automática el rango de las tablas se detecta cual es la última fila hasta llegar a la fila vacía, por eso es necesario por lo menos una fila en blanco entre tabla y tabla, los siguientes códigos determinan cual es la ultima fila y última columna del rango de la tabla y lo copia:

uf = a.Range("A" & pf).End(xlDown).Row
pc = a.Range("A" & pf).Address
pwc = Mid(pc, InStr(pc, "$") + 1, InStr(2, pc, "$") - 2)

Se se observa el archivo de Word que se acompaña con el ejemplo y que se usa como plantilla, tiene marcado donde la macro debe pegar cada una de las tablas, en este ejemplo las tablas se enumeran de la uno en forma consecutiva empezando en la hoja uno, es por ello que si la tabla 5 por ejemplo se requiere en un determinado lugar de Word se debe escribir en la plantilla:

 [CAMPO_TABLA5]

La macro con el siguiente código busca el número de la tabla y la pega en forma vinculada, es decir si se modifica en Excel se modificará en Word, en el lugar indicado con el siguiente código:

ts = "[Campo_Tabla" & n & "]"
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable True, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
Wend

Seguidamente se muestra el código completo incluido en todo el formulario que se proporciona con el ejemplo llamado Como Copiar las Tablas de Todas las Hojas de Excel a Word en forma Vinculada, luego del código se encuentre el link para proceder a la descarga del ejemplo el cual recomiendo como así también ver el vídeo para que sea más fácil entenderlo.


Código que se inserta en un módulo de VBA

'**************https://programarexcel.com  **** https://youtube.com/programarexcel*********



Sub ExportaTablasWordVinc()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim objWord As Word.Application, wdDoc As Word.Document, hoja As Worksheet
On Error Resume Next
Set a = Sheets(ActiveSheet.Name)
nom = ActiveWorkbook.Name
pto = InStr(nom, ".")
nomarch = Left(nom, pto - 1)
ruta = ThisWorkbook.Path & "\" & nomarch & ".docx"
Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True
Set wdDoc = objWord.Documents.Open(ruta)
nomfic = nomarch & " " & Format(Date, "dd-mm-yyyy")
rutainf = ThisWorkbook.Path & "\" & nomfic & ".docx"
n = 1
'para cada hoja del libro
For Each hoja In Worksheets
Set a = Sheets(hoja.Name)
pf = 1
uff = a.Range("A" & Rows.Count).End(xlUp).Row


Do
uf = a.Range("A" & pf).End(xlDown).Row
pc = a.Range("A" & pf).Address
pwc = Mid(pc, InStr(pc, "$") + 1, InStr(2, pc, "$") - 2)

uf = uf
uc = a.Range("A" & pf).End(xlToRight).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)

a.Range(pwc & pf & ":" & wc & uf).Copy

ts = "[Campo_Tabla" & n & "]"
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.PasteExcelTable True, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
Wend

pf = uf + 3
n = n + 1
Loop While pf <= uff

wdDoc.SaveAs Filename:=rutainf, FileFormat:=wdFormatXMLDocument

Next 'proxima hoja
'wdDoc.Close
MsgBox ("Las " & n - 2 & " tablas se exportaron con éxito"), vbInformation, "AVISO"
'wdDoc.Quit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends      

Como copiar imagenes y graficos de Excel a Word conectando Excel con Word





La macro copia imágenes de Excel a Word, el ejemplo muestra como se recorre todas las imágenes que hay en el libro de Excel y copias las que tiene indicado el archivo Word que debe copiar y pega las fotos en el lugar donde se deben pegar las imágenes que están en Excel.

Para entender en forma más fácil el ejemplo que se presenta en el post sugiero bajar el archivo de ejemplo, descargado el mismo se podrá observar dos botones uno sirve para renombrar todas las imágenes que hay en el libro de Excel, luego haciendo click en cada imagen se puede saber como se llama la imagen de Excel, luego sabiendo el nombre se debe agregar en Word el nombre, en el lugar exacto donde se requiere que sea pegada la imagen que está en Excel.

Desde el final del post se puede descargar el ejemplo en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.








 


Haciendo click en la imagen se puede saber el nombre de la imagen, quizás sea útil saber como se renombrar las imágenes y que al hacer click salga msgbox con el nombre de la imagen, el nombre de la imagen es que se debe agregar en Word más precisamente en el lugar donde se debe pegar la imagen.

Al presionar el botón que ejecuta la macro y permite copiar las imágenes de Excel a Word, aparece un explorador de archivos de Windows que permite elegir el archivo Word que contiene el nombre de la imagen y el lugar de donde se pagarán las imágenes.

En este ejemplo el archivo de Word que se usa como plantilla no se sobrescribe sino que se crea un nuevo archivo con las imágenes de Excel copiadas a Word; primero se crea un objeto con el libro de Word que se abre, seguidamente se crea el nombre dle fichero que se usará para guardar el nuevo libro de Word; para ello se usa el siguiente código:

Set wdDoc = objWord.Documents.Open(ruta)
NOMFIC = nomarch & " " & Format(Date, "dd-mm-yyyy")
rutainf = ThisWorkbook.Path & "\" & NOMFIC & ".docx"


⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como crear una factura con excel, guardarla y enviarla por mail automáticamente


Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Como hacer un link o hiperlink a google maps con Excel

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛



⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Para recorrer todas las imágenes y pegarlas a Word se usa el siguiente código:

For x = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(x).CopyPicture
ts = "[PID" & x & "]"
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.Paste ' False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
ctaima = ctaima + 1
Wend
Next x

Noten que en el código anterior se recorre desde la primera a la última imagen de Excel, la macro copia la imagen, como las imágenes se habían renombrado en forma secuencial en la variable ts se guarda el nombre de la imagen que conjuntamente con el número que va tomando la variable del bucle forman el nombre de la imagen, que a su vez se corresponde con el nombre escrito en Word, si la macro encuentre el nombre que está recorriendo el bucle, en Word, automáticamente pega la imagen.

El ejemplo denominado Como copiar imágenes y gráficos de Excel a Word, se puede descargar desde el link del final y a continuación se presenta la codificación completa.


Código que se inserta en un módulo

Sub mostrarID()
nom = Application.Caller
MsgBox ("El nombre de la imagen es: " & nom)
End Sub

Sub CrearIDImagen()
On Error Resume Next
For x = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(x).Name = "[PID" & x & "] "
ActiveSheet.Shapes(x).Select
Selection.OnAction = "mostrarID"
Next x
ActiveSheet.Shapes(5).Select
Selection.OnAction = "CrearIDImagen"
ActiveSheet.Shapes(35).Select
Selection.OnAction = "CopiaimagenWord"
MsgBox ("La ID de cada imagen fue creada con éxito, para saber su nombre click en imagen"), vbInformation, "AVISO"
Cells(20, "J").Activate
End Sub

Sub CopiaimagenWord()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim objWord As Word.Application, wdDoc As Word.Document
On Error Resume Next
Set a = Sheets(ActiveSheet.Name)

myfile = Application.GetOpenFilename("Archivos Excel (*.doc*), *.doc*")
FullName = Split(myfile, Application.PathSeparator)
a = FullName(UBound(FullName))
pto = InStr(a, ".")
nomarch = Left(a, pto - 1)
If VarType(myfile) = vbBoolean Then
MsgBox ("Operación cancelada"), vbCritical, "AVISO"
Exit Sub
End If

ruta = ThisWorkbook.Path & "\" & nomarch & ".docx"
Set objWord = CreateObject("Word.Application")
objWord.DisplayAlerts = wdAlertsNone
objWord.Visible = True
Set wdDoc = objWord.Documents.Open(ruta)
NOMFIC = nomarch & " " & Format(Date, "dd-mm-yyyy")
rutainf = ThisWorkbook.Path & "\" & NOMFIC & ".docx"

For x = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(x).CopyPicture
ts = "[PID" & x & "]"
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
While objWord.Selection.Find.Found = True
objWord.Selection.Paste ' False, True, False
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=ts
ctaima = ctaima + 1
Wend
Next x

wdDoc.SaveAs Filename:=rutainf, FileFormat:=wdFormatXMLDocument
'wdDoc.Close
MsgBox ("Se copiaron " & ctaima & " imagenes de Excel a Word"), vbInformation, "AVISO"
'wdDoc.Quit
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛


Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.


If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.


Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends