Crear Macro para mostrar mensaje

.13.02.17

Hola, Oscar

En mi opinión, una simple fórmula de CONTAR. SI() sería más práctica que lo que pides.

Supongamos que colocas esa fórmula en alguna celda de la hoja Indice, por ejemplo en C4:

=CONTAR.SI(B1:B24000;">1")

El rango de B lo defines a gusto y considera si usas separador de listas el punto y coma o sólo la coma.

De esta manera tendrás el número de pendientes siempre visible y actualizado.

Si, eventualmente, fuese necesario que te aparezca el mensaje al abrir el libro, esa fórmula seguirá siendo útil para que la siguiente rutina te lo informe.

Para que funcione, activa el editor de Visual Basic (presiona Alt+F11) y en el panel de la izquierda busca la hoja que dice "ThisWorkbook" (o "EsteLibro" según la versión")

Copia el código siguiente y pégalo en el panel desplegado a la derecha de su Editor de Visual Basic:

Private Sub Workbook_Open()
LaHoja = "Indice"
LaCelda = "C4"
cont = Sheets(LaHoja).Range(LaCelda).Value
ElMensaje = IIf(cont = 0, "No hay pendientes el la Columna B", "Existe " & IIf(cont > 1, "n", "") & cont & " pendiente" & IIf(cont > 1, "s", "") & Chr(10) & "en la columna B")
TipoMens = IIf(cont = 0, vbCritical, vbInformation)
ElTitulo = IIf(cont = 0, "SIN PENDIENTES", "CANTIDAD DE PENDIENTES")
Application.ScreenUpdating = True
MsgBox ElMensaje, TipoMens, ElTitulo
End Sub

Indicale al principio del código las direcciones de hoja y celda que correspondan a tu archivo.

De esta manera tienes resuelto lo que pedías y un adicional que es el recuento instantáneo de pendientes.

Espero que te sirva.

Un abrazo

Fer

.

Hola Fernando,

Espero que te encuentres bien, muchas gracias por tu ayuda, eso es lo que estoy buscando. Solo una cosa mas; el documento que tengo con la macros genera una copia de solo lectura. Hay alguna forma que este mensaje tambien aparezca en el documento de solo lectura. Ya que en este momento aparece el mensaje solo en el documento que contiene la Macros.

Muchas gracias.

Un abrazo

Oscar

.

Buenas, Oscar

Me alegro de que te haya servido.

Para que ocurra lo que solicitas, el documento de solo lectura debería tener esa misma rutina en ThisWorkbook.

Va a depender mucho, entonces, de cómo generes ese archivo. Si lo haces a trav´s de un Guardar Como... y mantienes la extensión xlsm, ese procedimiento debería quedar incluido en ese nuevo archivo.

Saludos

Fer

.

Hola Fernando,

Te cuento que una Macro que esta en el mismo documento genera un archivo de solo lectura y lo guarda en otra ubicación. Ese archivo se va guardando con nueva información de manera constante. ¿Hay alguna forma que ese archivo de solo lectura muestre el mensaje que genera la macro?.

Muchas gracias.

Un abrazo

Oscar.

Para que ocurra lo que solicitas, el documento de solo lectura debería tener esa misma rutina en ThisWorkbook.

Va a depender mucho, entonces, de cómo generes ese archivo. Si lo haces a trav´s de un Guardar Como... y mantienes la extensión xlsm, ese procedimiento debería quedar incluido en ese nuevo archivo.

Saludos

Fer

.

Hola Fernando,

Muchas gracias por tu ayuda como siempre; el archivo de extensión .xlsm tiene una macro que genera un archivo de solo lectura.

Hay alguna forma que cada vez que la macro guarde el nuevo archivo. xlsx de solo lectura pueda incluir dentro de este documento, la rutina que muestre el mensaje que me ayudas en esta pregunta. La siguiente macro es la que se utiliza para guardar el archivo. xlsx de solo lectura.

De antemano muchas gracias.

Saludos 

Oscar

Sub Grabar_xlsx()
    DirCopia = "C:\syncplicity\z003bpca\Documents\Bitacora\Bitacora\" 'carpeta donde grabar la copia sin macros y de solo lectura.
    'control de existencia de carpeta
    On Error Resume Next
    ChDir DirCopia
    If Err = 76 Then
    QueHago = MsgBox("la carpeta " & DirCopia & " NO existe." & Chr(10) & "¿La creo?", vbOKCancel, "NO ESTA ¿QUE HAGO?")
    If QueHago = 1 Then
        MkDir DirCopia
    Else
        Exit Sub
    End If
    End If
    Err.Clear
    On Error GoTo 0
    DirCopia = DirCopia & IIf(Right(DirCopia, 1) = "\", "", "\")
    NomArch = ActiveWorkbook.Name
    Carpeta = ActiveWorkbook.Path
    NomArchi = Left(NomArch, InStr(1, NomArch, ".") - 1)
    Application.ScreenUpdating = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.SaveAs DirCopia & NomArchi & ".xlsx", xlOpenXMLWorkbook, , xlYes
    If Err.Number <> 0 Then
        Else
    Workbooks.Open Carpeta & "\" & NomArch
    'Application.ScreenUpdating = True
    'Application.ScreenUpdating = False
    Windows(NomArchi & ".xlsx").Activate
        ElMensaje = "Este archivo y la copia de seguridad " & Chr(10) & NomArchi & ".xlsx" & " en " & DirCopia & Chr(10) & "acaban de grabarse."
        TipoMens = vbInformation
        ElTitulo = "ARCHIVOS GRABADOS"
        Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ThisWorkbook.Save
    ActiveWorkbook.Save
    End If
End Sub

.

Hola, Oscar

Ahora está más claro.

Entre las primeras respuestas te dije:

Va a depender mucho, entonces, de cómo generes ese archivo. Si lo haces a través de un Guardar Como... y mantienes la extensión xlsm, ese procedimiento debería quedar incluido en ese nuevo archivo.

Entonces en ese código deberías reemplazar donde dice ".xlsx" por ".xlsm"

Algo así como esto:

Sub Grabar_xlsm()
    DirCopia = "C:\syncplicity\z003bpca\Documents\Bitacora\Bitacora\" 'carpeta donde grabar la copia sin macros y de solo lectura.
    'control de existencia de carpeta
    On Error Resume Next
    ChDir DirCopia
    If Err = 76 Then
    QueHago = MsgBox("la carpeta " & DirCopia & " NO existe." & Chr(10) & "¿La creo?", vbOKCancel, "NO ESTA ¿QUE HAGO?")
    If QueHago = 1 Then
        MkDir DirCopia
    Else
        Exit Sub
    End If
    End If
    Err.Clear
    On Error GoTo 0
    DirCopia = DirCopia & IIf(Right(DirCopia, 1) = "\", "", "\")
    NomArch = ActiveWorkbook.Name
    Carpeta = ActiveWorkbook.Path
    NomArchi = Left(NomArch, InStr(1, NomArch, ".") - 1)
    Application.ScreenUpdating = False
    ActiveWorkbook.Save
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.SaveAs DirCopia & NomArchi & ".xlsm", xlOpenXMLWorkbookMacroEnabled, , xlYes
    If Err.Number <> 0 Then
        Else
    Workbooks.Open Carpeta & "\" & NomArch
    'Application.ScreenUpdating = True
    'Application.ScreenUpdating = False
    Windows(NomArchi & ".xlsm").Activate
        ElMensaje = "Este archivo y la copia de seguridad " & Chr(10) & NomArchi & ".xlsm" & " en " & DirCopia & Chr(10) & "acaban de grabarse."
        TipoMens = vbInformation
        ElTitulo = "ARCHIVOS GRABADOS"
        Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    ThisWorkbook.Save
    ActiveWorkbook.Save
    End If
End Sub

Creandolo así se preservan las rutinas que pudiese tener el archivo.

Espero que quede como esperas.

Un abrazo

Fer

.

Hola Fernando,

Muchas gracias, si efectivamente el documento así si muestra el mensaje. Podrías ayudarme con una cosa mas, dentro de esta macro que guarda el archivo nuevo, como podría hacer para que me guarde los dos archivos uno con extensión .xlsm y otro con extensión xls, y que los dos sean de solo lectura.

Muchas gracias

Saludos

Oscar.