Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Visual Basic » Necesito Adaptar Este Codigo

Visual Basic - Necesito Adaptar Este Codigo

Life is soft - evento anual de software empresarial
Volver
Nuevo Tema
<<>>
 
Vista:

Necesito Adaptar Este Codigo

Publicado por Nicolas (1 intervención) el 28/10/2019 21:59:36
Hola, estoy necesitando ayuda, si alguien me podria ayudar me vendria genial.
Necesito adaptar el siguiente codigo para que solo se envie si hay un numero en la columna B, C y D.
Yo tengo un listado de clientes y cada uno cuenta con 1, 2 o 3 celulares cargados, lo que me interesa es que no haga la accion de enviar whatsapp si la fila esta vacia o es distinta a un numero.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub EnviaWhatsapp()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set a = Sheets("Hoja1")
uf = a.Range("A" & Rows.Count).End(xlUp).Row
 
For x = 2 To uf
telwhatsapp = a.Cells(x, "B")
textwhatsapp = a.Cells(x, "E")
 
mylinkwhatsapp = "https://web.whatsapp.com/send?phone=" & telwhatsapp & "&text=" & textwhatsapp
ActiveWorkbook.FollowHyperlink mylinkwhatsapp
 
Application.Wait (Now + TimeValue("00:00:05")) 'tiempo del enter para enviar mensaje

ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje

Application.Wait (Now + TimeValue("00:00:01")) 'tiempo despues de cerrar pestaña activa para abrir otra ventana

ActiveWindow.Application.SendKeys "(~)" 'tiempo para abrir ventana nueva

 
Next x
 
For y = 2 To uf
telwhatsapp = a.Cells(y, "C")
textwhatsapp = a.Cells(y, "E")
 
mylinkwhatsapp = "https://web.whatsapp.com/send?phone=" & telwhatsapp & "&text=" & textwhatsapp
ActiveWorkbook.FollowHyperlink mylinkwhatsapp
 
Application.Wait (Now + TimeValue("00:00:05")) 'tiempo del enter para enviar mensaje

ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje

Application.Wait (Now + TimeValue("00:00:01")) 'tiempo despues de cerrar pestaña activa para abrir otra ventana

ActiveWindow.Application.SendKeys "(~)" 'tiempo para abrir ventana nueva

 
Next y
 
For Z = 2 To uf
telwhatsapp = a.Cells(Z, "D")
textwhatsapp = a.Cells(Z, "E")
 
mylinkwhatsapp = "https://web.whatsapp.com/send?phone=" & telwhatsapp & "&text=" & textwhatsapp
ActiveWorkbook.FollowHyperlink mylinkwhatsapp
 
Application.Wait (Now + TimeValue("00:00:05")) 'tiempo del enter para enviar mensaje

ActiveWindow.Application.SendKeys "(~)" 'énvia enter para enviar mensaje

Application.Wait (Now + TimeValue("00:00:01")) 'tiempo despues de cerrar pestaña activa para abrir otra ventana

ActiveWindow.Application.SendKeys "(~)" 'tiempo para abrir ventana nueva

 
Next Z
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 1.259
Plata
Ha mantenido su posición en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

Necesito Adaptar Este Codigo

Publicado por Antoni Masana (565 intervenciones) el 29/10/2019 15:54:15
He cambiado unas cuantas cosas:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub EnviaWhatsapp()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For x = 2 To Sheets("Hoja1").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets("Hoja1")
            If Len(.Cells(x,"B"))=9 And IsNumeric(.Cells(x,"B")) Then Call WhatsApp(.Cells(x,"B"),.Cells(x,"E"))
            If Len(.Cells(x,"C"))=9 And IsNumeric(.Cells(x,"C")) Then Call WhatsApp(.Cells(x,"C"),.Cells(x,"E"))
            If Len(.Cells(x,"D"))=9 And IsNumeric(.Cells(x,"D")) Then Call WhatsApp(.Cells(x,"D"),.Cells(x,"E"))
        End With
    Next Z
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
' --------------------------------------------------------------------------

 
Private Sub WhatsApp(tel_Whatsapp, text_Whatsapp)
    My_Link_Whatsapp = "https://web.whatsapp.com/send?phone=" & tel_Whatsapp & "&text=" & text_Whatsapp
 
    ActiveWorkbook.FollowHyperlink My_Link_Whatsapp
 
    Application.Wait (Now + TimeValue("00:00:05")) 'tiempo del enter para enviar mensaje

    ActiveWindow.Application.SendKeys "(~)"        'énvia enter para enviar mensaje

    Application.Wait (Now + TimeValue("00:00:01")) 'tiempo despúes de cerrar pestaña activa para abrir otra ventana

    ActiveWindow.Application.SendKeys "(~)"        'tiempo para abrir ventana nueva

End Sub

En España los número de teléfono son de 9 dígitos por eso comparo con un 9 si donde vives es diferente cambia el valor.


Saludos
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar