Vistas de página en total

lunes, 6 de mayo de 2013



Formulario para ingresar un nuevo producto a nuestra base de datos.





#1. En el botón "ACEPTAR" primero nos ubicaremos en la hoja.
#2. Crearemos una macro con la que no se permitirá que un nuevo producto tenga el mismo código que uno anterior.
#3. Condicionaremos.
#4. Guardaremos.
#5. Limpiaremos.
#6. Estableceremos que el código se coloque automáticamente. 


Private Sub CommandButton1_Click()
Sheets("DATOS").Select

On Error Resume Next
      Cells.Find(What:=TextBox1, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Comparacion.Caption = ActiveCell
    
If Comparacion.Caption = TextBox1 Or TextBox2 = Empty Then
    MsgBox "Código no valido!", vbOKOnly, "Error!"
    TextBox1 = Empty
    TextBox1.SetFocus
    
Else
    Range("A2").Select
    Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
    Loop
    
    ActiveCell = TextBox1.Value
    ActiveCell.Offset(0, 1).Select
    ActiveCell = TextBox2.Value
    ActiveCell.Offset(0, 1).Select
    ActiveCell = TextBox3.Value
    ActiveCell.Offset(0, 1).Select
    ActiveCell = TextBox5.Value
    ActiveCell.Offset(0, 1).Select
    ActiveWorkbook.Save
    MsgBox "Los datos fueron guardados con éxito", vbOKOnly, "Aceptar!"
    
    TextBox1 = [A12] + 1
    TextBox2 = Empty
    TextBox3 = Empty
    TextBox5 = Empty
    TextBox1.SetFocus
End If

End Sub
    
    
Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
TextBox1 = [A12] + 1
End Sub

--------------------------------------------------------------------------------------------------------------------

CREAR UN CONTROL DE ACCESO.






















#1. En el botón "CANCELAR" colocaremos el código dado a continuación para que cancele la acción.
#2. En el botón "ENTRAR" colocaremos el siguiente código dado a continuación para definir el usuario y la contraseña que serán admitidas para proseguir con la acción.


Private Sub CANCELAR_Click()
Unload UserForm3
End Sub

Private Sub LOGIN_Click()
If usuario.Text = "Darlin" And contraseña.Text = "1234" Then
MsgBox "BIENVENIDO A FERRETERÍA CASTOR", vbInformation, "felicidades"
UserForm2.Show
Else
MsgBox "Nombre de usuario o Contraseña Incorrecta", vbCritical, "alerta"
End If
End Sub


-----------------------------------------------------------------------------------------------------------------------------------------------

CREAR UNA FACTURA
















#1. En el botón "IMPRIMIR" se colocará el código que guarde todos los datos en una hoja de excel ya establecida.


Private Sub CommandButton1_Click()
Sheets("CLIENTES").Select
Range("k20").Select

If comparacion.Caption <> NIT Then
    Range("a2").Select
    Do While Not IsEmpty(ActiveCell)
    ActiveCell.Offset(1, 0).Select
   
    Loop
   
    ActiveCell = NOMBRE.Value
    ActiveCell.Offset(0, 1).Select
    ActiveCell = DIRECCION.Value
    ActiveCell.Offset(0, 1).Select
    ActiveCell = NIT.Value
End If

Sheets("FACTURA").Select
 Range("D5").Select
ActiveCell = NOMBRE
Range("D6").Select
ActiveCell = DIRECCION
Range("F5").Select
ActiveCell = FECHA
Range("F6").Select
ActiveCell = NIT
Range("H6").Select
 ActiveCell = FACTURA
   
Range("C9").Select
ActiveCell = COD1
ActiveCell.Offset(0, 1).Select
ActiveCell = PROD1
ActiveCell.Offset(0, 1).Select
ActiveCell = PREC1
ActiveCell.Offset(0, 1).Select
 ActiveCell = CAN1
ActiveCell.Offset(0, 1).Select
ActiveCell = SUB1
ActiveCell.Offset(0, 1).Select

Range("C10").Select
ActiveCell = COD2
ActiveCell.Offset(0, 1).Select
ActiveCell = PROD2
ActiveCell.Offset(0, 1).Select
 ActiveCell = PREC2
ActiveCell.Offset(0, 1).Select
ActiveCell = CAN2
ActiveCell.Offset(0, 1).Select
ActiveCell = SUB2
ActiveCell.Offset(0, 1).Select

Range("C11").Select
ActiveCell = COD3
ActiveCell.Offset(0, 1).Select
 ActiveCell = PROD3
ActiveCell.Offset(0, 1).Select
ActiveCell = PREC3
ActiveCell.Offset(0, 1).Select
ActiveCell = CAN3
ActiveCell.Offset(0, 1).Select
ActiveCell = SUB3
ActiveCell.Offset(0, 1).Select


Range("C12").Select
ActiveCell = COD4
ActiveCell.Offset(0, 1).Select
 ActiveCell = PROD4
ActiveCell.Offset(0, 1).Select
ActiveCell = PREC4
ActiveCell.Offset(0, 1).Select
ActiveCell = CAN4
ActiveCell.Offset(0, 1).Select
ActiveCell = SUB4
ActiveCell.Offset(0, 1).Select

Range("C13").Select
ActiveCell = COD5
ActiveCell.Offset(0, 1).Select
 ActiveCell = PROD5
ActiveCell.Offset(0, 1).Select
ActiveCell = PREC5
ActiveCell.Offset(0, 1).Select
ActiveCell = CAN5
ActiveCell.Offset(0, 1).Select
ActiveCell = SUB5
ActiveCell.Offset(0, 1).Select

Range("C14").Select
ActiveCell = COD6
ActiveCell.Offset(0, 1).Select
 ActiveCell = PROD6
ActiveCell.Offset(0, 1).Select
ActiveCell = PREC6
ActiveCell.Offset(0, 1).Select
ActiveCell = CAN6
ActiveCell.Offset(0, 1).Select
ActiveCell = SUB6
ActiveCell.Offset(0, 1).Select

Range("H28").Select
 ActiveCell = TOTAL

Sheets("DATOS").Select
Range("a1").Select

On Error Resume Next
    Cells.Find(What:=COD1.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
         , SearchFormat:=False).Activate
       
        ActiveCell.Offset(0, 3).Select
        ActiveCell = ActiveCell - Val(CAN1)
       
On Error Resume Next
    Cells.Find(What:=COD2.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
         xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
       
        ActiveCell.Offset(0, 3).Select
        ActiveCell = ActiveCell - Val(CAN2)
       
On Error Resume Next
    Cells.Find(What:=COD3.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
       
        ActiveCell.Offset(0, 3).Select
        ActiveCell = ActiveCell - Val(CAN3)
       
        If comparacion.Caption <> NIT Then
        MsgBox "Se a gurdado el nuevo cliente y estan listos para imprimir", vbOKOnly, "Resultado"
         Else: MsgBox "Los datos estan listos para imprimir", vbOKOnly, "Resultado"
        End If
       
[J25] = [J25] + 1

End Sub


---------------------------------------------------------------------------------------------------------------------------------------------------
#2. En el botón "LIMPIAR" colocaremos los siguientes códigos.



Private Sub CommandButton3_Click()
NOMBRE = Empty
DIRECCIÓN = Empty
NIT = Empty
FACTURA = [H6] + 1
COD1 = Empty
COD2 = Empty
COD3 = Empty
COD4 = Empty
COD5 = Empty
COD6 = Empty
PROD1 = Empty
PROD2 = Empty
PROD3 = Empty
PROD4 = Empty
PROD5 = Empty
PROD6 = Empty
PREC1 = Empty
PREC2 = Empty
PREC3 = Empty
PREC4 = Empty
PREC5 = Empty
PREC6 = Empty
CAN1 = Empty
CAN2 = Empty
CAN3 = Empty
CAN4 = Empty
CAN5 = Empty
CAN6 = Empty
SUB1 = Empty
SUB2 = Empty
SUB3 = Empty
SUB4 = Empty
SUB5 = Empty
SUB6 = Empty

End Sub



--------------------------------------------------------------------------------------------------------------------------------------------------


Private Sub NIT_Change()
Sheets("clientes").Select
Range("a1").Select

On Error Resume Next
    Cells.Find(What:=NIT, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    comparacion.Caption = ActiveCell
   
    If comparacion.Caption = NIT Then
        Selection.Offset(, -2).Select
        NOMBRE.Value = ActiveCell
        Selection.Offset(, 1).Select
        DIRECCION.Value = ActiveCell
    End If
   
    If NIT = Empty Then
        Selection.Offset(, 5).Select
        NOMBRE.Value = Empty
        DIRECCION.Value = Empty
    End If
   
End Sub

Private Sub COD1_Change()
If NIT.Value = "" Then
    COD1 = Empty
    NIT.SetFocus
Else

Sheets("DATOS").Select
Range("k20").Select

On Error Resume Next
    Cells.Find(What:=COD1.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    ActiveCell.Offset(, 1).Select
    PROD1.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    PREC1.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    EX1.Value = ActiveCell
End If
End Sub

Private Sub COD2_Change()
If NIT.Value = "" Then
    COD2 = Empty
    NIT.SetFocus
Else

Sheets("DATOS").Select
Range("k20").Select

On Error Resume Next
    Cells.Find(What:=COD2.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    ActiveCell.Offset(, 1).Select
    PROD2.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    PREC2.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    EX1.Value = ActiveCell
End If
End Sub
Private Sub COD3_Change()
If NIT.Value = "" Then
    COD3 = Empty
    NIT.SetFocus
Else

Sheets("DATOS").Select
Range("k20").Select

On Error Resume Next
    Cells.Find(What:=COD3.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    ActiveCell.Offset(, 1).Select
    PROD3.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    PREC3.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    EX1.Value = ActiveCell
End If
End Sub
Private Sub COD4_Change()
If NIT.Value = "" Then
    COD4 = Empty
    NIT.SetFocus
Else

Sheets("DATOS").Select
Range("k20").Select

On Error Resume Next
    Cells.Find(What:=COD4.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    ActiveCell.Offset(, 1).Select
    PROD4.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    PREC4.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    EX1.Value = ActiveCell
End If
End Sub
Private Sub COD5_Change()
If NIT.Value = "" Then
    COD5 = Empty
    NIT.SetFocus
Else

Sheets("DATOS").Select
Range("k20").Select

On Error Resume Next
    Cells.Find(What:=COD5.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    ActiveCell.Offset(, 1).Select
    PROD5.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    PREC5.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    EX1.Value = ActiveCell
End If
End Sub
Private Sub COD6_Change()
If NIT.Value = "" Then
    COD6 = Empty
    NIT.SetFocus
Else

Sheets("DATOS").Select
Range("k20").Select

On Error Resume Next
    Cells.Find(What:=COD6.Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
   
    ActiveCell.Offset(, 1).Select
    PROD6.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    PREC6.Value = ActiveCell
    ActiveCell.Offset(, 1).Select
    EX1.Value = ActiveCell
End If
End Sub
Private Sub CAN1_Change()
If Val(EXIS1) > Val(CAN1) Then
MsgBox "No hay suficiente en existencia", vbOKOnly, "Error"
CAN1 = Empty
End If
CAN1.SetFocus
If CAN1 = "" Then
SUB1 = ""
Else: SUB1 = Val(PREC1) * Val(CAN1)
End If
End Sub

Private Sub CAN2_Change()
If Val(EXIS2) > Val(CAN2) Then
MsgBox "No hay suficiente en existencia", vbOKOnly, "Error"
CAN1 = Empty
End If
CAN1.SetFocus
If CAN2 = "" Then
SUB1 = ""
Else: SUB2 = Val(PREC2) * Val(CAN2)
End If
End Sub

Private Sub CAN3_Change()
If Val(EXIS3) > Val(CAN3) Then
MsgBox "No hay suficiente en existencia", vbOKOnly, "Error"
CAN1 = Empty
End If
CAN1.SetFocus
If CAN3 = "" Then
SUB1 = ""
Else: SUB3 = Val(PREC3) * Val(CAN3)
End If
End Sub

Private Sub CAN4_Change()
If Val(EXIS4) > Val(CAN4) Then
MsgBox "No hay suficiente en existencia", vbOKOnly, "Error"
CAN1 = Empty
End If
CAN1.SetFocus
If CAN4 = "" Then
SUB1 = ""
Else: SUB4 = Val(PREC4) * Val(CAN4)
End If
End Sub
Private Sub CAN5_Change()
If Val(EXIS5) > Val(CAN5) Then
MsgBox "No hay suficiente en existencia", vbOKOnly, "Error"
CAN1 = Empty
End If
CAN1.SetFocus
If CAN5 = "" Then
SUB1 = ""
Else: SUB5 = Val(PREC5) * Val(CAN5)
End If
End Sub

Private Sub CAN6_Change()
If Val(EXIS6) > Val(CAN6) Then
MsgBox "No hay suficiente en existencia", vbOKOnly, "Error"
CAN1 = Empty
End If
CAN1.SetFocus
If CAN6 = "" Then
SUB1 = ""
Else: SUB6 = Val(PREC6) * Val(CAN6)
End If
End Sub


Private Sub SUB1_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub
Private Sub SUB2_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub
Private Sub SUB3_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub
Private Sub SUB4_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub
Private Sub SUB5_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub
Private Sub SUB6_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub



Private Sub TOTAL_Change()
TOTAL = Val(SUB1) + Val(SUB2) + Val(SUB3) + Val(SUB4) + Val(SUB5)
If SUB1 = "" Then
TOTAL = ""
End If
End Sub


Private Sub UserForm_Initialize()
NIT.SetFocus
FECHA = Date
Sheets("DATOS").Select
FACTURA = [J25] + 1
End Sub






1 comentario: