Pasar codigo que comienza con Sub a una Function personalizada?
Publicado por BELINDA (3 intervenciones) el 07/05/2017 06:32:38
Hola amigos una consulta tengo un código visual basic (sub Consulta Dni)que lo vi en internet ,para buscar los nombres y direccion según dni Perú , pero yo quisiera crear una function , es decir que al poner la función personalizada en una celda EJEMPLO("E11") , me arroje el resultado que sería "Rpta"
Aqui el código y la macro en excel
Aqui el código y la macro en excel
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub ConsultaDNI()
'Esto es para controlar los errores
On Error Resume Next
'declaramos las variables a utilizar
Dim IE As Object
Dim Nombres, consulta, ubicacion As Object
Dim Rpta, Rpta2 As StringDim Dni As String
'Esto es para evitar que aparescan alerta de mensajes
With Application
.DisplayAlerts = False
End With
'limpiamos el campo donde se obtendrán los nombres antes de empezar
Range("d7:g9").ClearContents
'Celda que contendrá el n° de DNI | le damos formato de 8 digitos
Dni = Format(Range("E5").Text, "00000000")
'evitamos que el dni contenga letras
If Not IsNumeric(Dni) Then
MsgBox "Solo se permite el ingreso de valores numéricos", vbCritical, "ERROR"
Exit Sub
End If
'Este es un mensaje en la barra de estado que indica que se está realizando la consulta.
Application.StatusBar = "Consultando ... "
'creamos el objeto para realizar la conexión a internet
Set IE = CreateObject("InternetExplorer.Application")
'Navegamos en la web
IE.Navigate "http://votoinformado.pe/voto/miembro_mesa.aspx"
'Creamos un bucle para esperar que la web cargue por completo.
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
'Desde Excel enviamos el número de RUC
IE.Document.all.Item("txtCongrDNI").Value = Dni
'Hacemos clic en el boton consultar
Set consulta = IE.Document.getElementbyId("btnCongrDNI")
consulta.Click'Volvemos a esperar que la web cargue por completo
Do Until IE.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
'Esperamos unos segundos para evitar que el servidor nos cancele.
Application.Wait (Now + TimeValue("0:00:03"))
''Extraemos el nombre del DNI consultado
Set Nombres = IE.Document.getElementbyId("lblNombres")
Rpta = Nombres.InnerText
Set ubicacion = IE.Document.getElementbyId("lblUbicacion")
Rpta2 = ubicacion.InnerText
'He realizado una actualización para obtener también la ubicación
'Si el valor consultado es vacío entonces alertamos con este aviso, caso contrario obtenemos el nombre de la persona y su ubicación.
If Rpta = "" Then
Range("D7").Value = "El DNI ingresado no existe ó no se realizó la consulta."
Else
Range("D7").Value = Rpta
Range("D9").Value = Rpta2 'Esto es nuevo para obtener la ubicación, no lo verás en youtube.
End If
'Para que la consulta en la web no se vea, el valor debe ser Falso
IE.Visible = False
''Cerramos la conexión
IE.Quit'Con esto limpiamos la variable.
Set IE = Nothing'Regresamos a la normalidad
With Application
.DisplayAlerts = True
End With
'Con este mensaje indicamos que la consulta fue realizada.
Application.StatusBar = "Consulta realizada."
End Sub
- consulta-dni.zip(115,5 KB)
Valora esta pregunta
0