VBA MACRO Excel 2003: Msgbox cuando no se cumple una condición
Para Dante Amor o Elsa Matilde
Hola! Tengo la siguiente macro para resolver la siguiente situación:
Bloquear la celda C8 si la celda B8 está vacía
Bloquear F8:H8 si la celda G8 está vacía
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address(False, False) = "B8" Then
ActiveSheet.Unprotect "abc"
If WorksheetFunction.Trim(Target) = "" Then
Range("C8").Locked = True
Else
Range("C8").Locked = False
End If
ActiveSheet.Protect "abc"
End If
If Target.Address(False, False) = "G8" Then
ActiveSheet.Unprotect "abc"
If WorksheetFunction.Trim(Target) = "" Then
Range("F8,H8").Locked = True
Else
Range("F8,H8").Locked = False
End If
ActiveSheet.Protect "abc"
End If
End SubAhora bien, necesito agregar una línea al código que:
Cuando no se complete la celda B8 y se intente escribir en C8, me arroje un cartel que diga que primero debo completar la celda B8
(Idem para la otra condición)
M u c h a s g r a c i a s
1 Respuesta
H o l a:
Te anexo la macro actualizada.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Count > 1 Then Exit Sub
If Target.Address(False, False) = "B8" Then
ActiveSheet.Unprotect "abc"
If WorksheetFunction.Trim(Target) = "" Then
Range("C8").Locked = True
Else
Range("C8").Locked = False
End If
ActiveSheet.Protect "abc"
End If
If Target.Address(False, False) = "C8" Then
If Target = "" Then Exit Sub
If [B8] = "" Then
MsgBox "primero debo completar la celda B8"
Target = ""
Target.Select
End If
End If
'
If Target.Address(False, False) = "G8" Then
ActiveSheet.Unprotect "abc"
If WorksheetFunction.Trim(Target) = "" Then
Range("F8,H8").Locked = True
Else
Range("F8,H8").Locked = False
End If
ActiveSheet.Protect "abc"
End If
If Not Intersect(Target, Range("F8, H8")) Is Nothing Then
If Target = "" Then Exit Sub
If [G8] = "" Then
MsgBox "primero debo completar la celda G8"
Target = ""
Target.Select
End If
End If
End Sub
Te lo agradezco muchísimo... sin embargo me di cuenta que es más práctico hacer que me mande el cartel de aviso y haga unas tareas de copiar+pegar. Te anexo tu macro modificada:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address(False, False) = "D7" Then
If Target = "" Then Exit Sub
If [C7] = "" Then
MsgBox "Primero debe completar el Nombre del Transporte", vbExclamation, "PAPEL NOA"
ActiveSheet.Unprotect "papel"
Range("D1").Select
Selection.Copy
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C7").Select
ActiveSheet.Protect "papel"
End If
End If
If Not Intersect(Target, Range("F7, G7, H7")) Is Nothing Then
If Target = "" Then Exit Sub
If [E7] = "" Then
MsgBox "Primero debe completar el Nombre del Transporte", vbExclamation, "PAPEL NOA"
ActiveSheet.Unprotect "papel"
Range("F1:H1").Select
Selection.Copy
Range("F7").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect "papel"
End If
Range("E7").Select
End If
End SubAhora bien, tengo un problema con la línea 73 (me sale un cartel que dice "Error '13'.... no coinciden los tipos"). No sé dónde está el error.
H o l a:
La macro que te envié hace lo que solicitaste.
Con mucho gusto te ayudo con todas tus peticiones.
Valora esta respuesta y crea una nueva pregunta en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor"
Sal u dos
