Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL

Como Enviar Emojis en Whatsapp con Excel NUEVA Version #496

Enviar Emoji por Whatsapp desde Excel

Enviar Emoji por Whatsapps desde Excel

Este es otro de los tantos post publicados acerca sobre como enviar Whatsapp con Excel, en este caso se va a proceder a mostrar como enviar Emojis desde Whatsapp con Excel VBA.

Si requieres aprender a manejar o profundizar tus conocimientos en Excel hazlo con los mejores 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, te lo recomiendo no te arrepentirás.

  
 

En 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 nuestro canal de You Tube, mira el playlist con  vídeos relacionados donde podrás ver la macro en acción con una explicación en forma visual que ayudará a entender el ejemplo en forma más fácil.

Envío de Emoji desde Whatsapp  con VBA

Para Enviar Mensajes con Emojis de Whatsapp con Excel, se debe presionar seleccionar el teléfono, texto del mensaje y el emoji que se encuentra en el listbox que está en el formulario.

Presionando el botón que tiene el logo de Whatsapp se procede a enviar el mensaje de Whatsapp con el Emoji a través de Excel.

Explicación de la Macro para Enviar Emoji por Whatsapp desde Excel

Par enviar Emoji se debe seleccionar primero el teléfono y luego el mensaje o viceversa, el tema es que este el teléfono y el mensaje es un dato obligatorio caso contrario la macro no envía ningún mensaje, el código que válida que se hayan ingresado datos es:

If telwhatsapp = Empty Or textwhatsapp = Empty Then
MsgBox («Debe ingresar número de teléfono y texto para enviar Whatsapp»), vbCritical, «AVISO»
Exit Sub
End If

El Emoji para enviar por Whatsapp desde Excel, se debe seleccionar desde el Listbox, dicho listado surge al cargar el formulario, ya que el userform al iniciar contiene una macro que establece que se debe cargar un Array o Matriz al Listbox con los nombres de los Emojis, el código es el siguiente y debe ir en el formulario en el evento «Initialize»

UserForm1.ListBox4.List = Array(«:Ok», «:Mono», «:Sonrisa»)

Si bien se muestra una imagen o Emoji en Whatsapp el mismo tiene un nombre y es el que se debe agregar en el texto o string a enviar para que Whatsapp convierta el nombre de dicho emoji en una imagen.

El nombre de los Emojis se pueden encontrar medianamente fácil si se los busca en Google, una vez determinado el nombre se debe cargar en el Array que llenará el listbox con los nombres de Emojis, en este caso solo carga 3 nombres «Ok, símbolo de pulgar arriba, Mono, símbolo de un mono con la cara tapada; Sonrisa, símbolo de una cara con una sonrisa, ustedes pueden buscar en Internet y cargar el Emoji que requieran.

Al hacer click y seleccionar el Emoji, la macro concatena el texto a enviar con el nombre del Emoji  y se envía a la API de Whatsapp quien convierte el Nombre del Emoji en la Imagen del Emoji, el código que convierte el Emoji seleccionado en texto que se enviará a la API de Whatsapp es el siguiente y se encuentra en el evento Click del Listobox4, fíjense como se concatena el texto que está en el Textbox1 y el nombre del Emoji que lo obtiene del ítem seleccionado del Listbbox4.

Private Sub ListBox4_Click()
fila = UserForm1.ListBox4.ListIndex
emo = UserForm1.ListBox4.List(fila)
UserForm1.TextBox1 = UserForm1.TextBox1 & » » & emo
End Sub

El código que envía el Whatsapp con Emoji desde Excel es el siguiente, se debe tener presente que no es necesario tener el contacto registrado para enviar Whatsapp desde Excel con macro, es decir se puede enviar un Mensaje de Whatsapp con Excel sin tener el contacto registrado en el teléfono.

El código que se envía a la API de Whatsapp contiene el número de teléfono, además concatenado el texto y el nombre del Emoji, siendo el código para el envío de Whatsapp desde Excel con Emoji el siguiente:

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

Application.Wait (Now + TimeValue(«00:00:08»))
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «(~)»
Application.Wait (Now + TimeValue(«00:00:05»))
ActiveWindow.Application.SendKeys «(~)» ‘énvia enter para enviar mensaje
Application.Wait (Now + TimeValue(«00:00:02»))
ActiveWindow.Application.SendKeys «(~)»
End Sub



Quizás también interese leer:

Macro VBA recorre filas, busca y copia datos en base a criterios 
Copia datos, abre otro libro pega datos y lo cierra 
Barra de progreso para una apariencia profesional 

Descarga del código del aplicativo Enviar Emoji en Whatsapp desde Excel

Desde el final de este post se puede descargar el ejemplo utilizado haciendo click en el link respectivo de descarga, es absolutamente gratis, solicito aportar a sostener la esta web si está dentro de tus posibilidades, desde ya muchas gracias.

Código que se encuentra en Modulo 1 Enviar Emoji por Whatsapp

Public telwhatsapp, textwhatsapp
Sub Muestra()
UserForm1.Show
End Sub
Sub EnviaWhatsapp()
‘*********** by marcrodos **** https://macrosenexcel.com *** https://www.youtube.com/c/programarexcel?sub_confirmation=1 ********

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:08»))
ActiveWindow.Application.SendKeys «{TAB}»
ActiveWindow.Application.SendKeys «(~)»
Application.Wait (Now + TimeValue(«00:00:05»))
ActiveWindow.Application.SendKeys «(~)» ‘énvia enter para enviar mensaje
Application.Wait (Now + TimeValue(«00:00:02»))
ActiveWindow.Application.SendKeys «(~)»
End Sub

Código que se Encuentra en el Formulario que Envía Emoji por Whatsapp desde Excel

Private Sub CommandButton1_Click()
telwhatsapp = UserForm1.TextBox8
textwhatsapp = UserForm1.TextBox1
Call EnviaWhatsapp
End Sub

Private Sub ListBox3_Click()
On Error Resume Next
ctlsaltachange = 1
UserForm1.TextBox8 = Empty
fila = UserForm1.ListBox3.ListIndex
UserForm1.TextBox8 = UserForm1.ListBox3.List(fila, 1)
UserForm1.TextBox9 = UserForm1.ListBox3.List(fila, 0) & » » & UserForm1.ListBox3.List(fila, 1) & » » & UserForm1.ListBox3.List(fila, 2)

UserForm1.ListBox3.Visible = False

If TextBox9 = Empty Then
UserForm1.Label2.Visible = True ‘hace visible el label
Else
UserForm1.Label2.Visible = False
End If

If TextBox8 = Empty Then
UserForm1.Label1.Visible = True ‘hace visible el label
Else
UserForm1.Label1.Visible = False
End If

ctlsaltachange = 0
End Sub

Private Sub ListBox4_Click()
fila = UserForm1.ListBox4.ListIndex
emo = UserForm1.ListBox4.List(fila)
UserForm1.TextBox1 = UserForm1.TextBox1 & » » & emo
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 TextBox8_Change()
If TextBox8 = Empty Then
UserForm1.Label1.Visible = True ‘hace visible el label
Else
UserForm1.Label1.Visible = False
End If
End Sub

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

‘If ctlsaltachange = 1 Then Exit Sub

If TextBox9 = Empty Then
UserForm1.Label2.Visible = True ‘hace visible el label
Else
UserForm1.Label2.Visible = False
End If

If Len(UserForm1.TextBox9) <= 2 Then
UserForm1.ListBox3.Visible = False
Exit Sub
Else
UserForm1.ListBox3.Visible = True
End If

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;»»»

If Len(UserForm1.TextBox9) > 2 Then
sql = «SELECT * FROM [» & «Hoja1$» & «] WHERE Ucase(» & a.Range(«A1») & «) LIKE Ucase(‘%» & UserForm1.TextBox9 & «%’) ORDER BY Nombre ASC»
Set rs = cn.Execute(sql)

UserForm1.ListBox3.Clear

Set rs = cn.Execute(sql)
If rs.EOF = True Then
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
UserForm1.ListBox3.Visible = False
Exit Sub
Else

UserForm1.ListBox3.Column = 3
UserForm1.ListBox3.ColumnWidths = «100 pt;70 pt;80 pt»

rs.MoveFirst
Do While Not rs.EOF
UserForm1.ListBox3.AddItem rs.Fields(0).Value
UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount – 1, 1) = rs.Fields(1).Value
UserForm1.ListBox3.List(UserForm1.ListBox3.ListCount – 1, 2) = rs.Fields(2).Value
‘ Userform1.ListBox3.List(Userform1.ListBox3.ListCount – 1, 3) = rs.Fields(4).Value
‘ Userform1.ListBox3.List(Userform1.ListBox3.ListCount – 1, 4) = rs.Fields(5).Value
‘ Userform1.ListBox3.List(Userform1.ListBox3.ListCount – 1, 5) = rs.Fields(6).Value
rs.MoveNext
Loop
End If

End If
Set rs = Nothing
cn.Close
Set cn = Nothing

‘Si solo hay un dato coincidente directamente lo busca y carga sus datos, al seleccionarlo se ejecuta el evento click del listbox
If UserForm1.ListBox3.ListCount – 1 = 0 Then
‘El código 1 salta la programacion del evento change del combobox16 porque sino cuando la macro modifica se vuelve a ejecutar y se obtiene resultado no deseado
‘saltacbo16 = 1
‘La macro al seleccionar el item automáticamente ejecuta la programación del evento click que es la búsqueda del dato y que
‘es lo que interesa en esta programación, por eso no se llama luego al evento listbox_click sino se ejecuta dos veces.
UserForm1.ListBox3.Selected(0) = True
‘Call ListBox3_Click
UserForm1.ListBox3.Visible = False
‘Se hace perder el foco al combobox16, porque sino se ejecuta la codificación del After_Update
‘Userform1.TextBox2.SetFocus
End If
‘salir:
‘Vuelve la variable a estado 0 para que se pueda ejecutar el evento change con otro registro
‘saltacbo16 = 0
Application.ScreenUpdating = True
Application.ScreenUpdating = True

End Sub
Private Sub UserForm_Initialize()
ExpteWhatsapp = «SUSCRIBE https://www.youtube.com/c/programarexcel?sub_confirmation»
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.ListBox4.List = Array(«:Ok», «:Mono», «:Sonrisa»)

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.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407

Summary
Author Rating
1star1star1star1star1star
Aggregate Rating
5 based on 1 votes