Version mejorada por MacroAntonio y Pegones AQUI en post #9

Hola {

=============

= ROLLO INICIAL =

=============

Hace ya un año desde que nuestro amigo Antoni nos descubriera la programación en VBA project en esta consulta (ver), es decir, programar en el propio proyecto VBA y alterar el código que siempre ha sido estático para la mayoría.

Este tipo de programación tiene un gran "pero", y es que la seguridad para ejecutar "VBA Editor" es demasiado alta por lo que es necesario realizar antes una configuración de referencias y permisos para que el código pueda ejecutarse en versiones posteriores a Excel 2000. Mas información en la página de Pearson (Programming The VBA Editor), o al final de este post, donde explico brevemente los pasos para los que quieran la ayuda rápida o no dominen bien ingles.

Dedico el aporte a Pedro, quien me inspiró en su énfasis a la hora de reducir mas y mas el peso de los archivos a la hora de subir aportes. Espero puedas sacarle provecho. Y ya pasamos al aporte:

===========

= EL APORTE =

===========

El código que va a ser extraído por la macro extractora, (cortito por ser un ejemplo pero puede ser tantos módulos, procedimientos y líneas como se desee):

This Is The Start

Sub EstoEsUnaPrueba()

    Dim Cosa As Integer

    For Cosa = 1 To 3

        Cells(Cosa, 1) = Cosa

        MsgBox "Hola mundo cruel"

    Next Cosa

End Sub

This Is The End[/CODE]

El siguiente código, es una macro que extrae información de una página cualquiera, en este caso este mismo post que estáis leyendo. Extrae el código del [b]anterior[/b] cuadro de CODE comprendido entre "[color=Green]This Is The Start[/color]" y "[color=Green]This Is The End[/color]" que es la macro de ejemplo, (un codigo simple cualquiera). Luego crea el modulo y el procedimiento extraído. Elimina el modulo1 con la macro original de extracción y finalmente ejecuta la nueva función.

[CODE]Sub Extractor()
Dim IE As Object
Dim CODE As String
Dim Pos1 As Long, Pos2 As Long, Pos As Long: Pos = 1
Dim Fila As Integer: Fila = 0

'Extrayendo información de www.ayudaexcel.com/foro
Set IE = CreateObject("internetexplorer.application")
With IE
.Navigate "about:blank"
.Visible = False
.Navigate "https://www.ayudaexcel.com/foro/showthread.php?t=18210"
Do While .busy
Application.Wait Now + TimeSerial(0, 0, 1)
Loop
Application.Wait Now + TimeSerial(0, 0, 1)
End With
Pos1 = InStr(1, IE.Document.DocumentElement.OuterHTML, "This Is The Start", vbTextCompare)
Pos2 = InStr(Pos1, IE.Document.DocumentElement.OuterHTML, "This Is The End", vbTextCompare)
CODE = Mid(IE.Document.DocumentElement.OuterHTML, Pos1 + 17, Pos2 - Pos1 - 17)
IE.Quit
Set IE = Nothing

'Llamada a función que aun no existe
Application.OnTime Now + TimeValue("00:00:01"), "EstoEsUnaPrueba"

'Ensamblando Módulo
Pos1 = 1
Pos2 = InStr(1, CODE, Chr(10), vbTextCompare)
ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "ModuloEnsamblado"
Do While Pos2
Fila = Fila + 1
ActiveWorkbook.VBProject.VBComponents("ModuloEnsamblado").CodeModule.InsertLines Fila, _
Replace(Replace(Mid(CODE, Pos1, Pos2 - Pos1), Chr(10), ""), Chr(13), "")
Pos1 = Pos2: Pos2 = InStr(Pos1 + 1, CODE, Chr(10), vbTextCompare)
Loop
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Módulo1")
End Sub[/CODE]

No sabia como se llamaba a un procedimiento que aun no existia sin que saltara error, por eso he usado un OnTimeNow, para llamar a un procedimiento inexistente con un delay de 1 segundo.

El código es muy mejorable, esto era solo un boceto de una idea. Se podría profundizar para hacer que tenga muchas más funcionalidades, como por ejemplo, dejar colgadas online todas las funciones de un usuario y llamarlas por medio de una función extractora a la que únicamente habría que enviarle de parámetros, por ejemplo, el nombre de usuario, Nombre_función, etc...

[b][color=Green]

[center]==============

= INSTRUCCIONES =

==============[/center]

[/color][/b]

[b] - Paso 0) [/b] Creamos un nuevo libro y dentro del mismo agregamos un modulo (Debe llamarse "Módulo1", si no, tendréis que alterar el código). Dentro del modulo, copiar la función "Sub Extractor()". Podeis saltar el Paso 0 descargando el libro de ejemplo adjunto.

[b] - Paso 1)[/b] Añadir referencia: Desde VBA / References: Microsoft Visual Basic For Applications Extensibility 5.3

[b] - Paso 2) [/b] Permitir Seguridad:

__ - (En excel 2003): Herramientas / Macro / Seguridad / pestaña (Editores de confianza) marcamos: Confiar en el acceso a proyectos de Visual Basic.

__ - (Posterior a 2003): Opciones de excel / Centro de confianza / Configuración del centro de confianza / Configuración de macros: Marcamos casilla "Confiar en el acceso al modelo de objetos de proyectos de VBA"

} Un saludo, espero que os guste.

EnsamblarWebVBA.zip

Hola Santi:

Me da error "5 Argumento no válido" en esta línea:

    Pos2 = InStr(Pos1, IE.Document.DocumentElement.OuterHTML, "This Is The End", vbTextCompare)

[/CODE]

Tengo las referencias Ok y la configuración seguridad correcta.

Saludos

Hola Antoni,

Lo acabo de descargar y ejecutar con excel 2003 y excel 2007 y me funciona. Creo que no te está haciendo bien la navegacion. El error viene del Pos1, la linea anterior no te está encontrando el texto "This Is The Start" dentro del "IE.Document.DocumentElement.OuterHTML", por lo que al realizar busqueda en Pos2 desde Pos1=0 da error, lo cual me indica que puede ser que no se te esté cargando bien la pagina.

Puede ser por la version de IE que tienes, yo tengo la 8, ¿tu cual tienes?. Si puedes hacer alguna prueba depurando el Outer en pos1 y pos2, te lo agradeceria.

Un saludo

Hola Santi:

Tengo la versión 6 de IE, ya que uso Chrome como navegador, supongo que es eso.

Al llegar a Pos1=.............. da un "Error de automatización", y el IE da un error diciendo que debe cerrarse.

¿Puedo bajarme la versión 8 de algún sitio ?

Saludos.

Hola Santi:

Así me funciona:

Sub Extractor()

    Dim xml As Object, web

    Dim Pos1 As Long, Pos2 As Long, Pos As Long: Pos = 1

    Dim Fila As Integer: Fila = 0


    'Borramos el nódulo por si lo volvemos a ejecutar

    On Error Resume Next

    ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("ModuloEnsamblado")

    On Error GoTo 0


    'Conectamos con la página web

    Set xml = CreateObject("Microsoft.XMLHTTP")

    web = "https://www.ayudaexcel.com/foro/showthread.php?t=18210"

    xml.Open "POST", web, False

    xml.Send

    Texto = xml.responseText


    'Buscamos inicio y final

    Pos1 = InStr(1, Texto, "This Is The Start", vbTextCompare)

    Pos2 = InStr(Pos1, Texto, "This Is The End", vbTextCompare)

    CODE = Mid(Texto, Pos1 + 17, Pos2 - Pos1 - 17)


    'Ensamblando Módulo

    Pos1 = 1

    Pos2 = InStr(1, CODE, Chr(10), vbTextCompare)

    ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "ModuloEnsamblado"

    Do While Pos2

        Fila = Fila + 1

        ActiveWorkbook.VBProject.VBComponents("ModuloEnsamblado").CodeModule.InsertLines Fila, _

            Replace(Replace(Mid(CODE, Pos1, Pos2 - Pos1), Chr(10), ""), Chr(13), "")

        Pos1 = Pos2: Pos2 = InStr(Pos1 + 1, CODE, Chr(10), vbTextCompare)

    Loop


End Sub

[/CODE]

Pruébalo a ver que te parece.

Saludos.

Hola Antoni,

Puedes bajartela desde AQUI, el sitio de microsoft que es donde me la bajé yo.

Ya eran inconvenientes el tener que agregar complementos y permisos para que ademas no vaya con versiones anteriores de IE...

No tiene mucho sentido que no vaya con el 6. Lo que haré será instalarme la version 6 de ie y pruebo a ver que está pasando.

Saludos y gracias por tu interes.

EDIT: Acabo de ver tu segunda respuesta, a ver que lo miro y te comento

EDIT2: Antoni, funciona a la perfeccion. Lo único es que sustituia las comillas por """"", le he agregado un replace mas

Replace(Replace(Replace(Mid(CODE, Pos1, Pos2 - Pos1), Chr(10), ""), Chr(13), ""), """, """")[/CODE]

y ahora ya va como se supone tenia que ir.

No conocia la existencia del objeto ("Microsoft.XMLHTTP"), ¿Es esto mejor que IE para descargar contenido de las paginas?

Gracias por arreglar el problemilla y por las mejoras

Dejo el codigo con las modificaciones:

[CODE]Sub Extractor()
Dim xml As Object, web
Dim Pos1 As Long, Pos2 As Long, Pos As Long: Pos = 1
Dim Fila As Integer: Fila = 0

'Borramos el nódulo por si lo volvemos a ejecutar
On Error Resume Next
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("ModuloEnsamblado")
On Error GoTo 0

'Conectamos con la página web
Set xml = CreateObject("Microsoft.XMLHTTP")
web = "https://www.ayudaexcel.com/foro/showthread.php?t=18210"
xml.Open "POST", web, False
xml.Send
Texto = xml.responseText

'Buscamos inicio y final
Pos1 = InStr(1, Texto, "This Is The Start", vbTextCompare)
Pos2 = InStr(Pos1, Texto, "This Is The End", vbTextCompare)
CODE = Mid(Texto, Pos1 + 17, Pos2 - Pos1 - 17)

'Llamada a función que aun no existe
Application.OnTime Now + TimeValue("00:00:01"), "EstoEsUnaPrueba"

'Ensamblando Módulo
Pos1 = 1
Pos2 = InStr(1, CODE, Chr(10), vbTextCompare)
ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "ModuloEnsamblado"
Do While Pos2
Fila = Fila + 1
ActiveWorkbook.VBProject.VBComponents("ModuloEnsamblado").CodeModule.InsertLines Fila, _
Replace(Replace(Replace(Mid(CODE, Pos1, Pos2 - Pos1), Chr(10), ""), Chr(13), ""), """, """")
Pos1 = Pos2: Pos2 = InStr(Pos1 + 1, CODE, Chr(10), vbTextCompare)
Loop
End Sub[/CODE]

Un saludo

PD EDIT3: Se me olvido agradecerte el post, muy eficaz tu solucion, acabo de comprobar que tambien funciona con IE 6.0.

A mi me sale el siguiente error...

[ATTACH]23469.vB[/ATTACH]

¿Por qué será?

Hola Trebur,

El error puede deberse a no tener permitidos permisos de seguridad para el proyecto

- Paso 2) Permitir Seguridad:

__ - (En excel 2003): Herramientas / Macro / Seguridad / pestaña (Editores de confianza) marcamos: Confiar en el acceso a proyectos de Visual Basic.

__ - (Posterior a 2003): Opciones de excel / Centro de confianza / Configuración del centro de confianza / Configuración de macros: Marcamos casilla "Confiar en el acceso al modelo de objetos de proyectos de VBA"

Saludos.

Santi, gracias por la dedicatoria y por publicar este estupendo aporte.

He incluido en el adjunto un par de cosas:

• Cambiar el nombre del Módulo1 por modExtractor.
  
• Como dice Cheap Person, mediante programación con código, agrega la referencia:
  Microsoft Visual Basic For Applications Extensibility 5.3
  
• Definir la constante vbext_ct_StdModule para que esté declarada antes de agregar la referencia anterior.
  
• Incluir variable NuevaMacro con la nueva subrutina que se ejecutará una vez descargada de esta página Web.
  

Así, ya no hace falta:

- Paso 1) Añadir referencia: Desde VBA / References: Microsoft Visual Basic For Applications Extensibility 5.3

A los que tenemos marcado en el editor de VBA (VBE) la opción:

Herramientas > Opciones > Editor > Requerir declaración de variables

nos genera error de compilación:

"Los comentarios solamente pueden aparecer después de End Sub, End Function o End Property"

porque añade detrás de la nueva macro:

Option Explicit

¡Ánimo Santi, sigue así!

Aprovecho para mandar un respetuoso saludo al master Macro Antoni.

EnsamblarWebVBA2.zip

Listo, gracias...

Hola Pedro

Muchas gracias por la mejora del código. De todas las versiones es la que va mejor, es bastante rápida.

No le agregué la macro de referencias por qué no paraba de darme errores, aun así veo que el tuyo va perfecto. Lo has mejorado mucho así que lo linko en el primer post.

Como te dije, esto es mas latoso de manejar que la bonita idea que tenía en la cabeza desde un principio, pero era una espinita que tenia ahí clavada de hace tiempo y aun que la gente no lo llegue a usar ni se le saque provecho, al menos ya me la he quitado.

Un saludo Pedro y gracias por darme siempre ánimos.

Hola Santi,

Por tu firma veo que aún te queda la espinita de

On Error Resume Next

de la que dice Microsoft:

"El método de control de errores no estructurado mediante On Error puede degradar el rendimiento de la aplicación, y dificultar la depuración y el mantenimiento del código. Se recomienda utilizar el método de control de errores estructurado."

¡¡¡Pero el control de errores estructurado no existe en VBA!!! Como dice el gurú Cheap Pearson en:

The Future Of Error Handling In VBA

El control de errores en VB6 y VBA se basa en la declaración de On Error, que es una estructura de código inadecuada. Lenguajes como C++ proporcionan una estructura de código Try/Catch que permite mucha más granularidad y control. En algún momento en el futuro, Microsoft introducirá su plataforma NET en Office, y cuando esto suceda, los programadores de VBA tendrán a su disposición el método de control de errores estructurado con Try/Catch que los desarrolladores de VB.NET ya disfrutan.

En la siguiente página se busca un sustituto:

Try-Catch for VB

Uno de los mayores handicaps de Excel es la nula renovación en cuanto a implementar las nuevas y mejoradas características de VB.NET en el código VBA. ¡Algún día Microsoft se pondrá las pilas! ¿o no?

Hola Pedro,

Lo cierto es que si que me ha dado muchos dolores de cabeza el control de errores en Visual Basic, hasta que hace como 1 año, vi como era de facil evitarlo mediante el uso de funciones auxiliares.

Ahora lo que siempre hago es, un main principal totalmente controlado donde nada puede dar error. Si algo puede dar error, lo convierto en funcion y lo saco fuera del Main, así en lugar de recibir el error recibo un boolean con el que ya es mas seguro trabajar. Te pongo un ejemplo rapido que te he hecho:

Sub ProgramaPrincipal()

    Dim Resultado As Double

    If Dividir(Resultado, 7, 0) Then

        MsgBox "El resultado es " & Resultado

    Else

        MsgBox "Error, division entre 0"

    End If

End Sub


Public Function Dividir(ByRef Resultado As Double, ByVal Dividendo As Double, ByVal Divisor As Double) As Boolean

    Dim Aux As Double

    On Error GoTo ErrorDividir

    '''''''''''''''''''''''''

    Aux = Dividendo / Divisor

    Resultado = Aux

    '''''''''''''''''''''''''

    Dividir = True

    Exit Function

ErrorDividir: Dividir = False

End Function[/CODE]

[b]¡¡¡Pero el control de errores estructurado no existe en VBA!!![/b] Como dice el gurú Cheap Pearson en:

El control de errores en VB6 y VBA se basa en la declaración de On Error, que es una estructura de código inadecuada. Lenguajes como C++ proporcionan una estructura de código Try/Catch que permite mucha más granularidad y control. En algún momento en el futuro, Microsoft introducirá su plataforma NET en Office, y cuando esto suceda, los programadores de VBA tendrán a su disposición el método de control de errores estructurado con Try/Catch que los desarrolladores de VB.NET ya disfrutan.

Los dos articulos muy interesantes, sobre todo el de "Try-Catch for VB" . Ahora me has planteado un dilema, ¿debería seguir usando mi sistema de anular errores? o pasarme al de Cpearson .... o ¿quizas usar una mezcla?

¡Algún día Microsoft se pondrá las pilas! ¿o no?

Eso espero, por lo menos a mi se me está haciendo cada vez mas pequeño VBA y ya van varias veces en las que he estado apunto de migrar de lenguaje, lo único que me lo ha impedido es la comodidad de tener las celditas excel a mano.

Un saludo!

Hola:

Yo habitualmente utilizo una de las propuestas de CPearson:

On Error Goto ErrHandler:

    N = 1 / 0    ' cause an error

    '

    ' more code

    '

    Exit Sub 

    ErrHandler:

    ' error handling code

    Resume Next

    End Sub[/CODE]

Aunque no soy excluyente de ninguna otra.

Lo que si hago muy a menudo es aprovecharme de los errores controlados para ahorrarme código, por ejemplo:

a=b/c sabemos que da error si [b]c es cero o b y/o no son números[/b]

Por lo tanto si b y c fueran 2 TextBox podríamos utilizar el error para emitir el mensaje:

[color=red]"El TextBox1 y/o el textbox2 deben ser numéricos. Corrija y reintente." [/color]

Oto ejemplo, tambien produce error referenciar el rango de una hoja que no existe, en este caso podemos usar el error para añadir una hojas [b]sin necesidad de recorrer la colección Sheets[/b].

Mas, el error al mover un valor a la propiedad .Text de un Listbox que no se corresponde con ninguna entrada, podemos usarlo para [b]no añadir repetidos a la lista[/b].

Y así un montón de errores que podemos usarlo en nuestro beneficio.

Besitos

Hola,

Tengo un problema, al correr la macro me sale un cuadro de dialogo que dice "Error en el metodo 'OnTime' de Objeto '_Aplication' ......

Podria ayudarme....