Saltar al contenido

Validar archivo antes de guardar y alertar


falexramos

Recommended Posts

publicado

Buenos días

Recurro como siempre a su ayuda para lo siguiente.

Lo que necesito hacer es una macro para que al guardar el archivo me haga una validacion de la columna E, indicando que no pueden dejar en blanco E4, E5, E6 y E8, etc,. Que obligatoriamante los deben seleccionar de la lista, y poner en color rojo las celdas que hacen falta por llenar este dato y no me permita guardar el archivo.

Agradezco la ayuda.

subo archivo de ejemplo, gracias.

Validacion antes de guardar.rar

publicado

Hola falexramos

Presiona ALT + F11 y luego pega el siguiente codigo en el objecto ThisWorkbook.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Trim(Range("E15").Value) = "" Or Trim(Range("E17").Value) = "" Or Trim(Range("E18").Value) = "" Or Trim(Range("E20").Value) = "" Then
MsgBox "No tienes permitido guardar el archivo." & vbCrLf & _
"Debes seleccionar las listas E15,E17,E18,E20 ", vbCritical, "Validacion"
Cancel = True
End If
End Sub[/CODE]

Luego debes guardarlo como una macro.

Saludos

publicado

elunico22, gracias por la respuesta, pero tengo un problema la idea es que no siempre sea el mismo rango, digamos a veces son 16 filas y otras son 2 o a veces ninguna, pero como la dejaste solo funciona es para este rango (E15,E17,E18,E20), y no esta resaltando la celda de color rojo. Agradezco tu ayuda.

publicado

Bueno aca te dejo otra solución segun entendí tu pregunta.

Suponiendo que en la columna 'E' tienes datos en el rango E2:E20

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim switch As Boolean
For i = 2 To 20
If Trim(Cells(i, 5).Value) = "" Then
switch = True

Range("E" & i).Interior.Color = 255
Else
Range("E" & i).Interior.Pattern = xlNone
End If
Next
'Validar si se encontraron errores
If switch = True Then
MsgBox "Existen datos vacios en la columna 'E'." & vbCrLf & _
"Por favor verificar las celdas de color rojo", vbExclamation, "Validación"
Cancel = True
End If
End Sub[/CODE]

Me comentas como te fue.

publicado

Saludos falexramos | Ayuda Excel y elunico22 | Ayuda Excel

Te dejo este código para que lo revises.


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim celda As Range
For Each celda In Sheets("hoja1").Range("E3:" & "E" & [D3].End(xlDown).Row)
If celda.Value = "" Then
H = 1
celda.Interior.Color = 255: celda.Value = "Debe seleccionar un ítem de la lista"
Cancel = True
End If
Next
If H = 1 Then MsgBox "Revisa que todos los campos estén llenos"
End Sub[/PHP]

Salu2

publicado

elunico22, la validacion que debe hacer es la siguiente en la columna A hay unos valores que son los de la lista desplegable dependienndo esa lista debe se debe poner un codigo al frente seleccionado de la lista Ej: si en D3 se pone "actr", obligatoriamente se debe escoger un codigo, pero si por el contrario se escoge "prueba2" no es necesario que se ingrese un codigo al frente se puede dejar en blanco.

en la columna A indico cuales son los que deben llevar codigo obligatoriamente, son los que esten resaltados en amarillo, los otros no.

-----------------------------------------------------////--------------------------------------------------------------------------------

Riddle de igual forma me sucede con tu ejemplo rellena todas las celdas que estan vacias.

Gracias por su tiempo.

publicado

Hola prueba así:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim celda As Range
For Each celda In Sheets("hoja1").Range("E3:" & "E" & [D3].End(xlDown).Row)
If celda.Value = "" Then
If InStr(1, celda.Offset(0, -1).Value, "prueba") Then
Else
H = 1
celda.Interior.Color = 255: celda.Value = "Debe seleccionar un item de la lista"
Cancel = True
End If
End If
Next
If H = 1 Then MsgBox "Revisa que todos lo campos esten llenos"
End Sub[/PHP]

Salu2

publicado

Riddle, gracias ya lo probe y funciona me señala en rojo y me dice que hace falta valores. tengo dos cuestiones.

1. Si por algun motivo mas adelante yo quisiera agregar otro item a la lista que no empezara con el nombre prueba si no con EJ: alfa o segundo y no requiera que ingresen el codigo ¿funcionaria la validación?

2. Al guardar hace la validacion, pero al darle guardar otra vez sin hacer ningun cambio solicitado deja guardar y no me dice que hace falta llenar datos.

Gracias por tu tiempo.

subo arhivo con el codigo

Validacion antes de guardar.rar

publicado

Adjunto archivo con algunas modificaciones, no hay problema si después quieres cambiar la palabra, ahora no permite guardar si no están llenos los espacios y si están llenos le quita el relleno rojo y lo deja transparente. Puedes agregar cuantas lineas quieras y ahora no distingue entre mayúsculas y minúsculas.

Como veras los datos los deje llenos por que si no, no me dejaría guardar el archivo.

Salu2

Validacion antes de guardar.zip

publicado

Riddle, Gracias funciona bien ya lo probe varias veces.

Ahora serias tan amable de explicar como funciona, gracias.

____________________________///______________________

DiegoPC, gracias funciona y no deja guardar perfecto, pero hay un inconveniente por ejemplo los unicos que deben llevar codigo obligado es son "actr" , "Enfgen" , "lim" , "lip". Los otros no importan si no tienen codigo, agradezco tu ayuda.

_____________________________////___________________

Yo tambien estube trabajando en un archivo no esta tan avanzado como el de ustedes pero si me gustaria que lo revisaran haber si voy por buen camino.

Validacion antes de guar falexramos.rar

publicado
Revisaste el adjunto que te deje??

Ya lo revise, pero no entiedo muy bien el codigo que me sale es:

Public h As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
verifica
If h = 1 Then
Cancel = True
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
verifica
If h = 1 Then Cancel = True
End Sub
Sub verifica()
Dim celda As Range, excluye_palabra As String
excluye_palabra = "prueba"
h = 0
For Each celda In Sheets("hoja1").Range("E3:" & "E" & [D3].End(xlDown).Row)
If celda.Value = "" Or celda.Value = "Debe seleccionar un item de la lista" Then
If InStr(1, UCase(celda.Offset(0, -1).Value), UCase(excluye_palabra)) Then
Else
celda.Select
h = 1
With celda
.Value = "Debe seleccionar un item de la lista"
.Interior.Color = 255
End With
End If
Else
celda.Interior.Pattern = xlNone
End If
Next
If h = 1 Then
MsgBox "Revisa que todos los campos esten llenos"
End If
End Sub[/CODE]

la parte que no entiendo muy bien es

[CODE]Dim celda As Range, excluye_palabra As String
excluye_palabra = "prueba"[/CODE]

y estas dos validaciones.

[CODE]If celda.Value = "" Or celda.Value = "Debe seleccionar un item de la lista" Then
If InStr(1, UCase(celda.Offset(0, -1).Value), UCase(excluye_palabra)) Then[/CODE]

publicado

Bueno no soy muy bueno explicando a ver si me doy a entender :

Public h As String ' h es una variable publica
Private Sub Workbook_BeforeClose(Cancel As Boolean)
verifica ' Llama la macro para verificar los datos
If h = 1 Then ' si la macro verifica da cm resultado que h =1
Cancel = True ' Impedimos que el libro se cierre y guarde lo cambios
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
verifica ' Llama la macro para verificar los datos
If h = 1 Then Cancel = True ' si la macro verifica da cm resultado que h =1 impedimos que guarde
End Sub
Sub verifica() '<----------------------
Dim celda As Range, excluye_palabra As String
excluye_palabra = "prueba" ' Palabra que excluiremos, no importa si esta en mayuscula o minuscula
h = 0 ' defino que h sera igual a Cero
For Each celda In Sheets("hoja1").Range("E3:" & "E" & [D3].End(xlDown).Row) ' Defino el rango donde
' se ejecutara el bucle
If celda.Value = "" Or celda.Value = "Debe seleccionar un item de la lista" Then
' Si la celda esta vacia o contiene "Debe seleccionar un item de la lista" continua
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If InStr(1, UCase(celda.Offset(0, -1).Value), UCase(excluye_palabra)) Then
'Ucase combierte las palabras a mayusculas, Instr busca una palabra dentro de un texto
'Si la celda contiene la palabra a excluir no hace nada''
Else 'De lo contrario '<''
h = 1 ' Define el valor de h como 1

With celda 'Definimos el contenido de la celda y color
.Value = "Debe seleccionar un item de la lista"
.Interior.Color = 255
End With
End If
Else ' si la celda no esta vasia le ponemos el color de fondo transparente
celda.Interior.Pattern = xlNone
End If
Next
If h = 1 Then 'Si h es igual a 1 alertamos con un mjs de error
MsgBox "Revisa que todos los campos esten llenos"
End If
End Sub[/PHP]

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29

    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Que tal nuevamente,  adjunto una solución alternativa: =MAX(A:.A)-BYROW(F4:.AK20,LAMBDA(r,BUSCAR(2,1/(r=0),F3:.AK3))) Cabe mencionar que esta solución requiere funciones nuevas como RECORTAR.RANGO. CONTADOR FINAL (Solucion).xlsb
    • Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • 'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.