En excel en una hoja ejecutar una macro para poner un mensaje y que siga ejecutando la macro hasta que acabe y borre el mensaje.

En Excel enn una hoja ejecutar una macro para poner una mensaje en la misma hoja ·espere un momento por favor", y que siga ejecuatando la macro hasta que se acabe, y después borrar el mensaje, he probado de copiar cuadro de texto e imágenes, pero me genera un numero nuevo cada vez que lo ejecuto.

1 Respuesta

Respuesta
2

Te anexo el código

Sub Macro1()
'Por.Dante Amor
    '
    On Error Resume Next
    ActiveSheet.Shapes("mensaje").Delete
    On Error GoTo 0
    izq = ActiveCell.Left
    arr = ActiveCell.Top
    Set figura = ActiveSheet.Shapes.AddShape(msoShapeRectangle, izq, arr, 100, 100)
    figura.Name = "mensaje"
    figura.TextFrame.Characters.Text = "Espere un momento por favor"
    DoEvents
    '
    'aquí va el código de tu macro
    '
    'Fin código de tu macro
    '
    On Error Resume Next
    ActiveSheet.Shapes("mensaje").Delete
    On Error GoTo 0
End Sub

.

.

He puesto después de DoEvents un msgbox" a ver si funciona" y range("a1")).select; y me pone primero el msgbox que va en mi macro y al aceptar me sale el cuadro de texto correcto, pero claro no me borra el cuadro de texto al acabar de ejectuar mi macro, porque primero ejecuta mi macro y despues me pone el cuadro de texto.

También te pregunto si es posible cambiar el tamaño de la letra a 28 y el color del texto a ROJO

Te pongo lal macro:

Sheets("Hoja1").Select
On Error Resume Next
ActiveSheet.Shapes("MENSAJE").Delete
On Error GoTo 0
Range("D11").Select
IZA = ActiveCell.Left
ARR = ActiveCell.Top
Set FIGURA = ActiveSheet.Shapes.AddShape(msoShapeRectangle, IZA, ARR, 300, 100)
FIGURA.Name = "MENSAJE"
FIGURA.TextFrame.Characters.Text = "ESPERA UN MMOMENTO POR FAVOR"
DoEvents
' AQUI VA MI MACRO
MsgBox "A VER SI BORRA EL CUADRO DE TEXTO"
Range("A1").Select

Agradecido de antemano, te saluda atentamente:

Alfredo

Realiza lo siguiente:

1. En tu hoja pon un botón

2. Al botón le asignas la siguiente macro

Sub Macro1()
'Por.Dante Amor
    '
    On Error Resume Next
    ActiveSheet.Shapes("mensaje").Delete
    On Error GoTo 0
    izq = ActiveCell.Left
    arr = ActiveCell.Top
    Set figura = ActiveSheet.Shapes.AddShape(msoShapeRectangle, izq, arr, 300, 100)
    figura.Name = "mensaje"
    figura.TextFrame.Characters.Text = "Espere un momento por favor"
    figura.TextFrame.Characters.Font.Size = 28          'tamaño
    figura.TextFrame.Characters.Font.ColorIndex = 3     'color rojo
    DoEvents
    '
    'aquí va el código de tu macro
    '
    For i = 1 To 3
        Application. Wait Now + TimeValue("00:00:01")
        DoEvents
    Next
    'Fin código de tu macro
    '
    On Error Resume Next
    ActiveSheet.Shapes("mensaje").Delete
    On Error GoTo 0
End Sub

3. Regresa a la hoja y presiona el botón

Lo primero que verás será el shape con el mensaje "Espere un momento por favor"

Después termina el ciclo del Wait y se borra el shape.

Nota: Si en alguna parte de la macro pones esto:  Application.ScreenUpdating = False, eso apaga las actualizaciones a la pantalla, por lo tanto no verás el shape. Por eso solamente pon el código que te estoy enviando para que lo pruebes.


Sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas