EVITAR PANTALLA EN BLANCO Y MENSAJE «VBA NO RESPONDE» CUANDO EJECUTAMOS UNA RUTINA EN VBA

Hola a todos!

En algunas ocasiones , cuando programamos nuestras rutinas en VBA y el número de loops que realizamos es alto o se subdivide en varios procesos, cuando pulsamos en la nuestra hoja excel o en la pantalla del editor de VBA cuando se está ejecutando el código, se bloquea y se pone totalmente en blanco y muestra el mensaje de que VBA o Excel no responde.

Pero en realidad sí está ejecutando el código solo que no lo vemos, dado que excel muestra ese mensaje como consecuencia de la acumulación de eventos en nuestro procedimiento en ejecución.

Aunque seguro que hay otras formas de hacerlo, os voy a comentar la forma en la que suelo evitar esto cuando es necesario que el usuario o bien, pueda observar cómo se van desarrollando los diferentes pasos de la macro o bien, si no está familiarizado con VBA, no crea que el programa no funciona o no responde.

Hay que tener en cuenta que este mensaje también puede surgir cuando realmente existe un problema con el código (programación deficiente, loops infinitos, etc), para esos casos esta solución no será efectiva).

Voy a utilizar un código con algunos loops de diferente tipo, for – next y do – while los cuales nos van a venir perfectos. El código está en este post publicado sobre smartart: PROGRAMAR SMARTART PARA GENERAR UN DIAGRAMA DE GANTT

Dado que debemos actuar en los loops o bucles, lo que vamos a hacer es forzar a vaciar los eventos que se van acumulando. Esto lo vamos a lograr con esta sencilla línea de código:

If (Variable del loop) Mod (divisor) = 0 Then DoEvents

Aquí podéis profundizar un poco más sobre el operador MOD y su utilidad en este código. Lo utilizamos para condicionar el funcionamiento del método «doevents»

Cuando el resultado de MOD, que es el residuo resultante de la división indicada en la condición sea igual a 0 entonces aplicamos doevents.

Esta condición, dependiendo del código, su estructura y variables, será necesario utilizarlo en diferentes parte de la macro. Normalmente en los bucles que resulten más lentos o extensos. Esto lo debéis ir verificando vosotros mismos cuando programéis vuestras rutinas.

En el ejemplo comentado, he incluido en tres ocasiones esta condición, lo resalto en rojo:

Sub DIAGRAMA_GANTT_SMARTART()
'Declaramos variables
Dim Diseño As SmartArtLayout
Dim Shape As Excel.Shape
Dim oNodos As SmartArtNodes
Dim inserta As Shape
Dim i As Integer, Fin As Integer
Dim j As Integer, valor As Double
Dim NPorcent As String, Per_2 As Long, Per_1 As Long
With Sheets("ESTRUCTURA")
.Select
'Eliminamos TODOS objetos en la hoja "ESTRUCTURA"
For Each Shape In .Shapes
Shape.Delete
Next
'Insertamos objeto SmartArt, en este caso "Jerarquía Multinivel"
Set Diseño = Application.SmartArtLayouts("urn:microsoft.com/office/officeart/2008/layout/HorizontalMultiLevelHierarchy")
Set inserta = .Shapes.AddSmartArt(Diseño)
Set oNodos = inserta.SmartArt.AllNodes
'Verificamos número de nodos necesarios contando los ítems de la página "DATOS"
Fin = Application.CountA(Sheets("DATOS").Range("A:A"))
'Creamos nodos
Do While oNodos.Count < Fin
oNodos.Add.Promote
'vaciamos eventos
If oNodos.Count Mod 2 = 0 Then DoEvents
Loop
'Eliminamos nodos sobrantes y los nombramos con la información de la hoja "DATOS"
For i = 2 To Fin
Do While oNodos(i - 1).Level < Sheets("DATOS").Range("B" & i).Value
oNodos(i - 1).Demote
Loop
'vaciamos eventos
If i Mod 2 = 0 Then DoEvents
Next
'Eliminamos último nodo (estará vacío al tener encabezado la hoja "DATOS")
oNodos(Fin).Delete
'aplicamos estilos
For Each Shape In .Shapes
'Colores
Shape.SmartArt.Color = Application.SmartArtColors("urn:microsoft.com/office/officeart/2005/8/colors/accent2_1")
'Estilos rápidos
Shape.SmartArt.QuickStyle = Application.SmartArtQuickStyles("urn:microsoft.com/office/officeart/2005/8/quickstyle/simple2")
'Iniciamos loop para recorrer el diagrama desde el último item al primero
For j = Fin To 2 Step -1
'Si el % está vacío, asignamos un valor 0 a la variable valor
If Sheets("DATOS").Range("F" & j).Value = Empty Then
valor = 0
ElseIf Sheets("DATOS").Range("F" & j).Value > 1 Then
valor = 1
Else
valor = Sheets("DATOS").Range("F" & j).Value
End If
'expresamos en color el porcentaje de cumplimiento de objetivos
With oNodos(j - 1).Shapes.Fill
.TwoColorGradient Style:=msoGradientVertical, Variant:=1
.GradientStops(2).Color = vbWhite
.GradientStops(1).Position = valor
.GradientStops(2).Position = valor
.GradientStops(1).Color.RGB = RGB(204, 204, 255)
End With
'Adicionalmente añadimos el porcentaje en número al diagrama y lo coloreamos en azul
With oNodos(j - 1)
.TextFrame2.TextRange.Text = Sheets("DATOS").Range("A" & j) & " " & Format(valor, "Percent")
NPorcent = Sheets("DATOS").Range("A" & j) & " " & Format(valor, "Percent")
Per_1 = UBound(Split(NPorcent)) + 1
Per_2 = UBound(Split(NPorcent)) + 2
.TextFrame2.TextRange.Words(Per_1).Font.Fill.ForeColor.RGB = vbBlue
.TextFrame2.TextRange.Words(Per_2).Font.Fill.ForeColor.RGB = vbBlue
End With
'vaciamos eventos
If j Mod 2 = 0 Then DoEvents
Next j
'Dimensionamos la imagen
With .Shapes(1)
.Height = 581.25 'Alto del objeto
.Width = 600.5 'Ancho del objeto
.Top = 100 ' Altura en la hoja
.Left = 14.25 ' A la izquierda de la hoja
End With
Next
End With
End Sub


El resultado es que además evitar que se congele nuestro proceso y por lo tanto el sistema nos diga que vba no responde, podemos ver cómo se desarrolla la macro en su totalidad.

Os he grabado un breve vídeo de la ejecución de esta macro para que veáis cómo funciona doevents:

[wpvideo CzwSXSBz]

Considero que no es necesario que os deje un archivo de prueba, creo que vosotros mismos podréis descargar del post anterior el código e introducir esta condición.

Os animo a realizar esta sencilla tarea para que comprobéis el cambio que se produce.

Y eso es todo, espero que facilite vuestros proyectos en VBA esta solución : )

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies