Como adaptar una macro que ya tengo

Necesito adaptar estas macros

Public boton
'
Sub boton_guardar()
'Por.Dante Amor
    boton = True
    ActiveWorkbook.Save
    MsgBox "Archivo guardado", vbInformation, "GUARDAR"
End Sub

Pon el siguiente código en los eventos de thisworkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Por.Dante Amor
    If SaveAsUI Or boton = False Then
        MsgBox "Solamente puedes guardar presionando el botón de Guardar ", vbExclamation
        Cancel = True
        Exit Sub
    End If
    boton = False
End Sub

con esta

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, _
Cancel As Boolean)
'If ActiveSheet.Range("H18") = "Ingrese Legajo primero" Then
'MsgBox ("Por favor ingrese o verifique el numero de legajo")
'Range("E18").Select
'Else
'Lunes
'If ActiveSheet.Range("J22") = "SI" Then
'If ActiveSheet.Range("E83") = "" Or ActiveSheet.Range("F83") = "" Then
'lunes = "lunes, "
'MsgBox ("Falta seleccionar menu del Lunes")
'End If
'End If
'Martes
'If ActiveSheet.Range("J34") = "SI" Then
'If ActiveSheet.Range("G83") = "" Or ActiveSheet.Range("H83") = "" Then
'martes = "martes, "
'MsgBox ("Falta seleccionar menu del Martes")
'End If
'End If
'Miercoles
'If ActiveSheet.Range("J46") = "SI" Then
'If ActiveSheet.Range("I83") = "" Or ActiveSheet.Range("J83") = "" Then
'miercoles = "miercoles, "
'MsgBox ("Falta seleccionar menu del Miercoles")
' End If
' End If
'Jueves
'If ActiveSheet.Range("J58") = "SI" Then
'If ActiveSheet.Range("K83") = "" Or ActiveSheet.Range("L83") = "" Then
'jueves = "jueves, "
'MsgBox ("Falta seleccionar menu del Jueves")
'End If
'End If
'Viernes
'If ActiveSheet.Range("J70") = "SI" Then
'If ActiveSheet.Range("M83") = "" Or ActiveSheet.Range("N83") = "" Then
'viernes = "viernes, "
'MsgBox ("Falta seleccionar menu del Viernes")
'End If
'End If
'If lunes = "lunes, " Or martes = "martes, " Or miercoles = "miercoles, " Or jueves = "jueves, " Or viernes = "viernes, " Then
'Alerta de los dias no completados
'MsgBox ("Falta seleccionar menu ó postre del día: " + lunes + martes + miercoles + jueves + viernes)
'If a = vbNo Then Cancel = True
'End If
'MsgBox ("La celda e6 NO es NUll")
'End If
End Sub

Sub GuardarCopia()
'Por.Dante Amor
If ActiveSheet.Range("H18") = "Ingrese Legajo primero" Then
MsgBox ("Por favor ingrese o verifique el numero de legajo")
Range("E18").Select
Exit Sub
End If
Dim verif As Boolean
verif = VerificarPedido()
If verif = False Then
Exit Sub
Else
ruta = ThisWorkbook.Path & "\"
Set h1 = Sheets("menu")
celda = "H18"
'
nombre = h1.Range(celda) & "_" & h1.Range("C18") & ".xlsm"
ThisWorkbook.SaveCopyAs ruta & nombre
MsgBox "Copia guardada en " & ruta + nombre, vbInformation, ""
Application.ActiveWorkbook.Save
Application.ActiveWorkbook.Close
End If
End Sub

Function VerificarPedido() As Boolean
'Lunes
If ActiveSheet.Range("J22") = "SI" Then
If ActiveSheet.Range("E83") = "" Or ActiveSheet.Range("F83") = "" Then
lunes = "lunes, "
'MsgBox ("Falta seleccionar menu del Lunes")
End If
End If
'Martes
If ActiveSheet.Range("J34") = "SI" Then
If ActiveSheet.Range("G83") = "" Or ActiveSheet.Range("H83") = "" Then
martes = "martes, "
'MsgBox ("Falta seleccionar menu del Martes")
End If
End If
'Miercoles
If ActiveSheet.Range("J46") = "SI" Then
If ActiveSheet.Range("I83") = "" Or ActiveSheet.Range("J83") = "" Then
miercoles = "miercoles, "
'MsgBox ("Falta seleccionar menu del Miercoles")
End If
End If
'Jueves
If ActiveSheet.Range("J58") = "SI" Then
If ActiveSheet.Range("K83") = "" Or ActiveSheet.Range("L83") = "" Then
jueves = "jueves, "
'MsgBox ("Falta seleccionar menu del Jueves")
End If
End If
'Viernes
If ActiveSheet.Range("J70") = "SI" Then
If ActiveSheet.Range("M83") = "" Or ActiveSheet.Range("N83") = "" Then
viernes = "viernes, "
'MsgBox ("Falta seleccionar menu del Viernes")
End If
End If
If lunes = "lunes, " Or martes = "martes, " Or miercoles = "miercoles, " Or jueves = "jueves, " Or viernes = "viernes, " Then
'Alerta de los dias no completados
MsgBox ("Falta seleccionar menu ó postre del día: " + lunes + martes + miercoles + jueves + viernes)
'If a = vbNo Then Cancel = True
VerificarPedido = False
Exit Function
End If
VerificarPedido = True
End Function

1 Respuesta

Respuesta
2

La macro para el evento de thisworkbook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Por.Dante Amor
    If SaveAsUI Or boton = False Then
        MsgBox "Solamente puedes guardar presionando el botón de Guardar ", vbExclamation
        Cancel = True
        Exit Sub
    End If
    boton = False
'Fin.Por.Dante Amor
    'If ActiveSheet.Range("H18") = "Ingrese Legajo primero" Then
    'MsgBox ("Por favor ingrese o verifique el numero de legajo")
    'Range("E18").Select
    'Else
    'Lunes
    'If ActiveSheet.Range("J22") = "SI" Then
    'If ActiveSheet.Range("E83") = "" Or ActiveSheet.Range("F83") = "" Then
    'lunes = "lunes, "
    'MsgBox ("Falta seleccionar menu del Lunes")
    'End If
    'End If
    'Martes
    'If ActiveSheet.Range("J34") = "SI" Then
    'If ActiveSheet.Range("G83") = "" Or ActiveSheet.Range("H83") = "" Then
    'martes = "martes, "
    'MsgBox ("Falta seleccionar menu del Martes")
    'End If
    'End If
    'Miercoles
    'If ActiveSheet.Range("J46") = "SI" Then
    'If ActiveSheet.Range("I83") = "" Or ActiveSheet.Range("J83") = "" Then
    'miercoles = "miercoles, "
    'MsgBox ("Falta seleccionar menu del Miercoles")
    ' End If
    ' End If
    'Jueves
    'If ActiveSheet.Range("J58") = "SI" Then
    'If ActiveSheet.Range("K83") = "" Or ActiveSheet.Range("L83") = "" Then
    'jueves = "jueves, "
    'MsgBox ("Falta seleccionar menu del Jueves")
    'End If
    'End If
    'Viernes
    'If ActiveSheet.Range("J70") = "SI" Then
    'If ActiveSheet.Range("M83") = "" Or ActiveSheet.Range("N83") = "" Then
    'viernes = "viernes, "
    'MsgBox ("Falta seleccionar menu del Viernes")
    'End If
    'End If
    'If lunes = "lunes, " Or martes = "martes, " Or miercoles = "miercoles, " Or jueves = "jueves, " Or viernes = "viernes, " Then
    'Alerta de los dias no completados
    'MsgBox ("Falta seleccionar menu ó postre del día: " + lunes + martes + miercoles + jueves + viernes)
    'If a = vbNo Then Cancel = True
    'End If
    'MsgBox ("La celda e6 NO es NUll")
    'End If
End Sub

Las macros para el módulo:

Public boton
'
Sub GuardarCopia()
    'Por.Dante Amor
    If ActiveSheet.Range("H18") = "Ingrese Legajo primero" Then
        MsgBox ("Por favor ingrese o verifique el numero de legajo")
        Range("E18").Select
        Exit Sub
    End If
    Dim verif As Boolean
    verif = VerificarPedido()
    If verif = False Then
        Exit Sub
    Else
        ruta = ThisWorkbook.Path & "\"
        Set h1 = Sheets("menu")
        celda = "H18"
        '
        boton = True
        nombre = h1.Range(celda) & "_" & h1.Range("C18") & ".xlsm"
        ThisWorkbook.SaveCopyAs ruta & nombre
        MsgBox "Copia guardada en " & ruta + nombre, vbInformation, ""
        Application.ActiveWorkbook.Save
        Application.ActiveWorkbook.Close
    End If
End Sub
'
Function VerificarPedido() As Boolean
    '
    'Lunes
    If ActiveSheet.Range("J22") = "SI" Then
    If ActiveSheet.Range("E83") = "" Or ActiveSheet.Range("F83") = "" Then
    lunes = "lunes, "
    'MsgBox ("Falta seleccionar menu del Lunes")
    End If
    End If
    'Martes
    If ActiveSheet.Range("J34") = "SI" Then
    If ActiveSheet.Range("G83") = "" Or ActiveSheet.Range("H83") = "" Then
    martes = "martes, "
    'MsgBox ("Falta seleccionar menu del Martes")
    End If
    End If
    'Miercoles
    If ActiveSheet.Range("J46") = "SI" Then
    If ActiveSheet.Range("I83") = "" Or ActiveSheet.Range("J83") = "" Then
    miercoles = "miercoles, "
    'MsgBox ("Falta seleccionar menu del Miercoles")
    End If
    End If
    'Jueves
    If ActiveSheet.Range("J58") = "SI" Then
    If ActiveSheet.Range("K83") = "" Or ActiveSheet.Range("L83") = "" Then
    jueves = "jueves, "
    'MsgBox ("Falta seleccionar menu del Jueves")
    End If
    End If
    'Viernes
    If ActiveSheet.Range("J70") = "SI" Then
    If ActiveSheet.Range("M83") = "" Or ActiveSheet.Range("N83") = "" Then
    viernes = "viernes, "
    'MsgBox ("Falta seleccionar menu del Viernes")
    End If
    End If
    If lunes = "lunes, " Or martes = "martes, " Or miercoles = "miercoles, " Or jueves = "jueves, " Or viernes = "viernes, " Then
    'Alerta de los dias no completados
    MsgBox ("Falta seleccionar menu ó postre del día: " + lunes + martes + miercoles + jueves + viernes)
    'If a = vbNo Then Cancel = True
    VerificarPedido = False
    Exit Function
    End If
    VerificarPedido = True
End Function

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Avísame cualquier duda

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Suma entre rango de fechas para un cliente

Nola, necesito hacer una suma entre un rango de fechas para un cliente definido. Elijo un rango de fechas y luego elijo un cliente de la celda de clientes y me da por resultado la suma de lo facturado de ese cliente dentro del rango de fechas...
3 respuestas

Necesito separar los dos nombres y los dos apellidos en una planilla excel

Tengo una planilla con tanto los nombres y apellido una solo a columna y necesito separar los dos nombres y los dos apellidos en columnas independiente
1 respuesta

Tengo una base de datos escrita en columnas

Necesito que quede escrita de la siguiente forma ¿Cómo lo puedo hacer?
3 respuestas

Macro para cortar un texto en 25 caracteres

Me ayudan a generar una macro que corte un texto que está en la celda A2 en 2 textos, el primer texto que lo ponga en la celda B2, no deberá cortar ninguna palabra deberá cortar el texto en máximo 25 caracteres y cortarlo en donde haya un blanco, el...
4 respuestas

Seleccionar datos mediante un Combobox en formulario

Tengo un listado de números en una columna y me gustaría seleccionar cada número mediante un Combobox de un formulario, su parte inicial sería la siguiente prívate sub combobox_change() Range (“ex”)
2 respuestas

Detectar si hay caracteres raros o acentos en texto excel

Tengo una base de datos que me da error cuando intento encontrar un texto en un campo, independientemente de si está acentuado o no y me da la sensación de que hay algún carácter raro en algún texto. ¿Hay alguna fórmula que me encuentre todos los...
2 respuestas

¿Cómo se quita mensaje de OLE?

A menudo excel se bloquea en todos los libros abiertos, luego al desbloquearse unos 3- 5 minutos después aparece el mensaje: "Microsoft Excel esta esperando que otra aplicación complete una acción OLE." ¿Cómo evitar todo esto y que no vuelva a suceder?
1 respuesta

Crear base de datos en excel

Como puedo crear una base de datos con Excel, que puedas introducir nombre, teléfono, tinte y registrar, buscar y eliminar
2 respuestas

Ocultar contraseña en macro

Tengo un archivo al cual le inserte una macro de apertura, que al abrir me pide contraseña, pero al digitarla muestra la contraseña, ¿Cómo hago para ocultarla? ¿Cómo hago para que al abrir esta me abra en una hoja especifica?
2 respuestas

Ejecutar macro si en la celda B1 hay datos

Esta es la macro que utilizo siempre, pero tengo la dificultad que a veces me olvido de colocar el numero de curso (Ejp. 1era_1era o 2da_2da ...)en la celda B1, todo este proceso se ejecuta en la hoja Activa "Curso", lo que busco que la macro se...
2 respuestas