PROGRAMAR EN VBA MACROS PARA EXCEL: agosto 2018

Como Enviar Whatsapp en Forma Masiva con Excel





El ejemplo muestra como mandar Whatsapp desde Excel en forma masiva, la variante anterior se mandaba un mensaje Whatsapp en forma individual, este ejemplo permite enviar un mensaje en forma masiva, se puede seleccionar desde un listbox varios contactos y mandar el mismo mensaje.

Puedes descargar el ejemplo en forma gratuita sin ninguna restricción desde el final del post, 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.









 



Al descargar el ejemplo se puede observar un botón al ejecutar se muestra un formulario al cargar el mismo se cargan los contactos que están en la base de datos, en este caso en la hoja1; dichos contactos son cargados en un listbox multiselect que está incluido en el formulario.

Con el botón MARCAR/ DESMARCAR se puede seleccionar todos los contactos o desmarcarlos, la macro determinará los contactos marcados enviando un mensaje Whatsapp a cada uno de los contactos seleccionados, realizándose el envío e mensaje Whatsapp desde Excel.

Para enviar el mensaje a los distintos contactos seleccionados se debe, primero marcar a quienes se desea enviar el mensaje seleccionando los contactos en el listbox, luego presionar el botón con el icono de Whatsapp, se procederá establecer que contactos están seleccionados en el listbox y a enviar el Whatsapp desde Excel, no es necesario utilizar el smartphone, solo es necesario previamente habilitar Whatsapp WEB para enviar mensajes de Whatsapp desde Excel.


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

Como abrir otro libro con password e importar datos


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

Como sumar datos seleccionados en listbox multiselect

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



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

Al presionar el botón para enviar Whatsapp se ejecuta una macro que es la siguiente:

For x = 0 To aa.ListCount - 1
If aa.Selected(x) = True Then
Num.Add aa.List(x, 1)
End If
Next x

El código anterior crea una colección, denominada Num, con los datos seleccionados del listbox, es decir recorre todas las filas del listbox determinando si está seleccionado el contacto en caso verdadero agrega el número a la colección, hecha la colección con todos los números seleccionados, que es a los contactos que se ele enviará el mensaje, procede a enviar un Whatsapp a cada contacto para ello se usa el siguiente código:

For Each dato In Num
conta = conta + 1
telwhatsapp = dato
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
Next dato

Como se observa en el código anterior, por cada dato que se encuentra en la colección se procede a enviar un mensaje de Whatsapp desde Excel, llamando al procedimiento que permite enviar el mensaje de Whatsapp, lo cual se hacer con el siguiente código:

Call EnviaWhatsapp


Para obtener más detalles como se enviar el mensaje se encuentra explicado con mayor detalle en Como enviar Whatsapp desde Excel, verás en detalle el código que envía el Mensaje de Whatsapp, seguidamente se muestra el código completo y posterior a ello el link para poder descargar el ejemplo.


Código que se inserta en un módulo

Public telwhatsapp, textwhatsapp
Sub Muestra()

'*********** by marcrodos **** https://programarexcel.com  ***  https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********

UserForm1.Show
End Sub
Sub EnviaWhatsapp()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

If telwhatsapp = Empty Or textwhatsapp = Empty Then
MsgBox ("Debe ingresar número de telefono y texto para enviar Whatsapp"), vbCritical, "AVISO"
Exit Sub
End If

mylinkwhatsapp = "https://api.whatsapp.com/send?phone=" & telwhatsapp & "&text=" & textwhatsapp
ActiveWorkbook.FollowHyperlink mylinkwhatsapp

Application.Wait (Now + TimeValue("00:00:05"))
ActiveWindow.Application.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("00:00:01"))
ActiveWindow.Application.SendKeys "{TAB}"
Application.Wait (Now + TimeValue("00:00:05"))
ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje
Application.Wait (Now + TimeValue("00:00:18"))
ActiveWindow.Application.SendKeys "(~)"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Código que se inserta en un formulario


Private Sub CommandButton1_Click()

'*********** by marcrodos **** https://programarexcel.com  ***  https://www.youtube.com/c/programarexcel?sub_confirmation=1 ************************************

Dim Num As New Collection, dato, conta As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'Crea una colección de datos del listbox
Set aa = UserForm1.ListBox1
For x = 0 To aa.ListCount - 1
If aa.Selected(x) = True Then
Num.Add aa.List(x, 1)
End If
Next x
conta = 0
For Each dato In Num
conta = conta + 1
telwhatsapp = dato
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
Next dato
MsgBox ("Se envió Whatsapp a  " & conta & " contactos"), vbInformation, "REPORTE"
End Sub

Private Sub CommandButton2_Click()
Set a = UserForm1.ListBox1
For x = 1 To a.ListCount - 1
If a.Selected(x) = True Then
a.Selected(x) = False
GoTo sal:
End If
If a.Selected(x) = False Then a.Selected(x) = True
sal:
Next x
End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = TextBox2
End Sub
Private Sub TextBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = TextBox3
End Sub

Private Sub TextBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
TextBox1 = TextBox4
End Sub

Private Sub TextBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = "Expte: " & UserForm1.TextBox2 & " Caratula " & UserForm1.TextBox3
TextBox1 = TextBox5
End Sub

Private Sub TextBox6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = "Expte: " & UserForm1.TextBox2 & " Caratula " & UserForm1.TextBox3
TextBox1 = TextBox6
End Sub

Private Sub TextBox7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1 = Clear
UserForm1.TextBox1 = "Expte: " & UserForm1.TextBox2 & " Caratula " & UserForm1.TextBox3
TextBox1 = TextBox7
End Sub


Private Sub UserForm_Initialize()
Dim cn As ADODB.Connection, rs As ADODB.Recordset, sql As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next


ExpteWhatsapp = "SUSCRIBE https://www.youtube.com/c/programarexcel?sub_confirmation=1"
UserForm1.TextBox1 = ExpteWhatsapp
UserForm1.TextBox2 = "Estimado recuerda " & ExpteWhatsapp & " activa la campanita y YouTube te avisara cuando se suba nuevo contenido "
UserForm1.TextBox3 = "Automatiza tus Libros Excel, tutoriales semanales, recuerda " & ExpteWhatsapp & " todas las semanas ideas sobre como automatizar tus libros Excel "
UserForm1.TextBox4 = "Mis datos son:" & Chr(13) & " https://www.youtube.com/c/programarexcel?sub_confirmation=1 " & Chr(13) & " comenta, dale LIKE si te fue útil"
UserForm1.TextBox5 = "Recuerda darle LIKE Y COMENTAR SI FUE UTIL: " & Chr(13) & "RECUERDA " & ExpteWhatsapp
UserForm1.TextBox6 = "Su próxima factura de ProgramarExcel.com vence el: " & Chr(13) & "14/06/2020 "
UserForm1.TextBox7 = "https://programarexcel.com Descarga cientos de ejemplos de Macros de Excel GRATIS, aporta al canal si puedes, sino con like, comentario y suscripción es suficiente"


UserForm1.ListBox1.ColumnCount = 2
UserForm1.ListBox1.ColumnWidths = "80 pt; 60 pt"

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set a = Sheets("Hoja1")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=Yes;"""
sql = "SELECT * FROM [" & "Hoja1$" & "]"

Set rs = cn.Execute(sql)
If rs.EOF = True Then
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
Else
UserForm1.ListBox1 = Clear
'Adiciona un item al listbox reservado para la cabecera
UserForm1.ListBox1.AddItem

rs.MoveFirst
Do While Not rs.EOF
    UserForm1.ListBox1.AddItem rs.Fields(0).Value
    UserForm1.ListBox1.List(UserForm1.ListBox1.ListCount - 1, 1) = rs.Fields(1).Value
    rs.MoveNext
Loop

'Carga los datos de la cabecera en listbox
For ii = 0 To rs.Fields.Count - 1
UserForm1.ListBox1.List(0, ii) = rs.Fields(ii).Name
Next ii

'Selecciona todos los items
For x = 1 To UserForm1.ListBox1.ListCount - 1
UserForm1.ListBox1.Selected(x) = True
Next x
End If
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 Sumar Textbox en Tiempo Real o Simultaneamente





La macro que se presenta en este post tiene origen en una sugerencia de un suscriptor de nuestro canal de YouTube es una macro que suma textbox en tiempo real, simultáneamente o a medida que se ingresan números.

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.









 


La macro que se presenta es muy simple consiste en un formulario de Excel con varios textbox, que al ingresar un importe en el textbox, simultáneamente o en tiempo real va sumando los datos ingresados en otro textbox.

Al presionar el botón que está en el archivo de ejemplo se muestra un formulario con tres textbox donde se ingresan los datos y un cuarto textbox donde se van sumando automáticamente o en tiemporreal a medida que se ingresan los datos en los otros textbox.


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

Como mostrar imagen animada en formulario Excel


Como agregar botón maximizar minimizar a formulario de Excel

Como buscar y cargar imagen de un catalogo en formulario Excel

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



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

Se debe dimensionar variables como tipo currency, son las variables t1, t2 y t3 que corresponde a los textbox1, textbox2 y textbox3

En el ejemplo se detecta si el dato ingresado es numérico, en ese caso, carga en las variables t1, t2 o t3 los respectivos datos de los textbox, a medida que se van ingresando los datos en estos textbox en el textbox4 en forma simultanea o tiempo real se van sumando los datos cargados en textbox.

Se debe tener presente que se debe agregar el código en el evento Change del textbox y en cada uno de los textbox sobre los cuales se desea sumar los datos ingresados en forma simultanea, en tiempo real o a medida que se escribe en textbox.

El código completo del ejemplo Como Sumar Textbox en Tiempo Real, se encuentra a continuación.


Código que se inserta en un Userform

Private Sub TextBox1_Change()
Dim t1 As Currency, t2 As Currency, t3 As Currency
On Error Resume Next
UserForm1.TextBox1 = Replace(UserForm1.TextBox1, ".", ",")  'Si se usa . como separador decimal cambiar punto Replace(UserForm1.TextBox1, ",", ".")
If IsNumeric(UserForm1.TextBox1) Then t1 = CDec(UserForm1.TextBox1)
If IsNumeric(UserForm1.TextBox2) Then t2 = CDec(UserForm1.TextBox2)
If IsNumeric(UserForm1.TextBox3) Then t3 = CDec(UserForm1.TextBox3)
UserForm1.TextBox4 = t1 + t2 + t3
End Sub


Private Sub TextBox2_Change()
Dim t1 As Currency, t2 As Currency, t3 As Currency
On Error Resume Next
UserForm1.TextBox2 = Replace(UserForm1.TextBox2, ".", ",")  'Si se usa . como separador decimal cambiar punto Replace(UserForm1.TextBox2, ",", ".")
If IsNumeric(UserForm1.TextBox1) Then t1 = CDec(UserForm1.TextBox1)
If IsNumeric(UserForm1.TextBox2) Then t2 = CDec(UserForm1.TextBox2)
If IsNumeric(UserForm1.TextBox3) Then t3 = CDec(UserForm1.TextBox3)
UserForm1.TextBox4 = t1 + t2 + t3
End Sub

Private Sub TextBox3_Change()
Dim t1 As Currency, t2 As Currency, t3 As Currency
On Error Resume Next
UserForm1.TextBox3 = Replace(UserForm1.TextBox3, ".", ",") 'Si se usa . como separador decimal cambiar punto Replace(UserForm1.TextBox3, ",", ".")
If IsNumeric(UserForm1.TextBox1) Then t1 = CDec(UserForm1.TextBox1)
If IsNumeric(UserForm1.TextBox2) Then t2 = CDec(UserForm1.TextBox2)
If IsNumeric(UserForm1.TextBox3) Then t3 = CDec(UserForm1.TextBox3)
UserForm1.TextBox4 = t1 + t2 + t3
End Sub

Código que se inserta en un módulo

Sub muestra()
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 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      

Como asignar una macro automaticamente a una imagen o shapes de Excel





En el post se muestra como asignar automáticamente una macro a una imagen, previamente se muestra como cambiar el nombre a las imágenes de Excel, asignándoles una macro en forma automática.

En el post anterior se publicó como pasar gráficos de Excel a Word, si es útil sigue el link, esta relacionado con este ejemplo, porque aca se explica parte del código que una el ejemplo mencionado.

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.









 



El ejemplo consta de dos partes una que permite cambiar el nombre de las imágenes que se encuentran en la hoja de Excel y la otra parte, va asignando automáticamente una macro a cada imagen, en este caso al tomar la imagen con el Mouse, aparece un mensaje con el nombre de la imagen.

La macro recorre todas las imagenes de la Hoja de Excel a través de un bucle, que se hace con el siguiente código:

For x = 1 To ActiveSheet.Shapes.Count

...

Next x


Con el siguiente código se va renombrando las imágenes para luego seleccionarla:

ActiveSheet.Shapes(x).Name = "[PID" & x & "] "

ActiveSheet.Shapes(x).Select

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
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

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



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

Con la imagen seleccionada, se le asigna una macro que en este caso es Mostrar ID, es decir muestra solamente el nombre de la imagen, pero se puede asignar cualquier macro.

Selection.OnAction = "mostrarID"

El código anterior asigna a una imagen seleccionada la macro mostrarID

El código completo de la macro que se denominó Como Asignar una Macro Automáticamente a una Imagen o Shapes de Excel, se puede observar a continuación  y seguidamente está el link de descarga del ejemplo.


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(17).Select
Selection.OnAction = "CrearIDImagen"
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

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


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