Formulario traspasos: verificar cantidad en un rango y descontar cantidad en otro.
Para Dante:
Hola:
Vuelvo a solicitarte tu ayuda para que me indiques como hacer para que en mi formulario Traspasos compare la cantidad a traspasar de un departamento a otro en el rango Disponible y si hay saldo para realizarlo descontar y sumar de cada departamento la cantidad en el rango cantidad inicial. Y si no hubiera cantidad suficiente mandara un msbox informando al usuario impidiendo realizar dicho traspaso.
Muchas gracias
Víctor
P.D: Te vuelvo a mandar mi archivo
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro para que se verifique en disponible:
Private Sub CMD_ACEPTAR_Click()
'Por.Dante Amor
If CMB_DE = "" Then Exit Sub
If CMB_A = "" Then Exit Sub
If CMB_COD = "" Then Exit Sub
If TXT_CANT_TRAS = "" Or Not IsNumeric(TXT_CANT_TRAS) Then Exit Sub
If TXT_ORDENTRAS = "" Then Exit Sub
'
Set h = Sheets("TOTAL GENERAL")
Set h2 = Sheets("TRASPASOS")
Set b = h.Rows("2:21").Find(CMB_DE, lookat:=xlWhole)
If Not b Is Nothing Then
col1 = b.Column
Set b = h.Rows("2:21").Find(CMB_A, lookat:=xlWhole)
If Not b Is Nothing Then
col2 = b.Column
Set b = h.Columns("A").Find(CMB_COD, lookat:=xlWhole)
If Not b Is Nothing Then
fila = b.Row
'
Set b = h.Rows(1).Find("CANTIDAD DISPONIBLE POR DEPARTAMENTOS", lookat:=xlWhole)
If Not b Is Nothing Then
col3 = ""
For i = b.Column To h.Cells(1, Columns.Count).End(xlToLeft).Column
If h.Cells(2, i) = CMB_DE Then
col3 = i
Exit For
End If
Next
If col3 <> "" Then
If h.Cells(fila, col3) >= Val(TXT_CANT_TRAS) Then
'Actualiza cantidad inicial
h.Cells(fila, col1) = h.Cells(fila, col1) - Val(TXT_CANT_TRAS)
h.Cells(fila, col2) = h.Cells(fila, col2) + Val(TXT_CANT_TRAS)
'
'Actualiza hoja Traspasos
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
num = Application.Max(h2.Range("A3:A" & u)) + 1
h2.Cells(u, "A") = num
h2.Cells(u, "B") = CMB_DE
h2.Cells(u, "C") = CMB_A
h2.Cells(u, "D") = TXT_F_TRASPASO
h2.Cells(u, "E") = TXT_ORDENTRAS
h2.Cells(u, "F") = CMB_COD
h2.Cells(u, "G") = CMB_VOZ_TRAS
h2.Cells(u, "H") = TXT_CANT_TRAS
h2.Cells(u, "I") = TXT_OBSERVACIONES
MsgBox "Traspaso realizado", vbInformation, "TRASPASOS"
Else
MsgBox "No se puede traspasar. La cantidad disponible del departamento DE: " & CMB_DE & _
" es menor a lo que quiere traspasar", vbCritical, "TRASPASOS"
End If
Else
MsgBox "No existe en disponible el Código: " & CMB_DE
End If
Else
MsgBox "No existe el encabezado : " & "CANTIDAD DISPONIBLE POR DEPARTAMENTOS"
End If
Else
MsgBox "No existe Código: " & CMB_COD
End If
Else
MsgBox "No existe Departamento: " & CMB_A
End If
Else
MsgBox "No existe Departamento: " & CMB_DE
End If
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
