Autoexec CFG
Autoexec CFG
Autoexec CFG
Exit Sub
End If
If TXTDESCRIPCION = "" Then
MsgBox "INGRESE DESCRIPCION"
TXTDESCRIPCION.SetFocus
Exit Sub
End If
If TXTCANTIDAD = "" Then
MsgBox "INGRESE CANTIDAD"
TXTCANTIDAD.SetFocus
Exit Sub
Else
If Not (IsNumeric(TXTCANTIDAD)) Then
MsgBox "LA CANTIDAD DEBE SER NUMEROS"
TXTCANTIDAD = ""
TXTCANTIDAD.SetFocus
Exit Sub
End If
End If
If TXTPRECIO = "" Then
MsgBox "INGRESE PRECIO"
TXTPRECIO.SetFocus
Exit Sub
Else
If Not (IsNumeric(TXTPRECIO)) Then
MsgBox "EL PRECIO DEBE SER NUMEROS"
TXTPRECIO = ""
TXTPRECIO.SetFocus
Exit Sub
End If
End If
Cells(NR + 3, 2) = TXTCODIGO
Cells(NR + 3, 3) = TXTDESCRIPCION
Cells(NR + 3, 4) = Val(TXTCANTIDAD)
Cells(NR + 3, 5) = Val(TXTPRECIO)
TXTCODIGO = ""
TXTDESCRIPCION = ""
TXTCANTIDAD = ""
TXTPRECIO = ""
TXTCODIGO.SetFocus
End Sub
End Sub
End Sub
End Sub
Private SubGRABAR_Click()
Sheets("ARTICULOS").Select
NR = Application.WorksheetFunction.CountA(Range("B:B"))
Exit Sub
End If
If TXTDESCRIPCION = "" Then
MsgBox "INGRESE DESCRIPCION"
TXTDESCRIPCION.SetFocus
Exit Sub
End If
If TXTCANTIDAD = "" Then
MsgBoox "INGRESE CANTIDAD"
TXTCANTIDAD.SetFocus
Exit Sub
Else
If Not (IsNumeric(TXTCANTIDAD)) Then
MsgBox "LA CANTIDAD DEBE SER NUMEROS"
TXTCANTIDAD = ""
TXTCANTIDAD.SetFocus
Exit Sub
End If
End If
If TXTPRECIO = "" Then
MsgBox "INGRESE PRECIO"
TXTPRECIO.SetFocus
Exit Sub
Else
If Not (IsNumeric(TXTPRECIO)) Then
MsgBox "EL PRECIO DEBE DER NUMERO"
TXTPRECIO = ""
TXTPRECIO.SetFocus
Exit Sub
End If
End If
Cells(NR + 2, 1) = TXTCODIGO
Cells(NR + 2, 2) = TXTDESCRIPCION
Cells(NR + 2, 3) = Val(TXTCANTIDAD)
Cells(NR + 2, 4) = Val(TXTPRECIO)
TXTCODIGO = ""
TXTDESCRIPCION = ""
TXTCANTIDAD = ""
TXTPRECIO = ""
TXTCODIGO.SetFocus
End Sub
End Sub
End Sub
BOTON SALIR DEL FORMULARIO EXCEL
TXTPRECIO.SetFocus
Exit Sub
Else
If Not (IsNumeric(TXTPRECIO)) Then
MsgBox "EL PRECIO DEBE DER NUMERO"
TXTPRECIO = ""
TXTPRECIO.SetFocus
Exit Sub
End If
End If
Cells(NR + 2, 1) = TXTCODIGO
Cells(NR + 2, 2) = TXTDESCRIPCION
Cells(NR + 2, 3) = Val(TXTCANTIDAD)
Cells(NR + 2, 4) = Val(TXTPRECIO)
TXTCODIGO = ""
TXTDESCRIPCION = ""
TXTCANTIDAD = ""
TXTPRECIO = ""
TXTCODIGO.SetFocus
End Sub
End Sub
End Sub
End Sub
End If
If OptionButton2.Value = "Verdadero" Then
ActiveCell.Offset(0, 6).FormulaR1C1 = "0"
End If
MsgBox "¡Registro exitoso!", vbOKOnly, "Registro"
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
End If
End Sub
Sub reunion()
Application.OnTime TimeValue("12:17:00"), "AVISO"
End Sub
Sub AVISo()
MsgBox "Faltan 1 minutos para la presentar tu dashboard de resultados"
End Sub
'
Application.ScreenUpdating = False
Range("E7:E12").Select
Selection.Copy
Sheets("Inventario").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E8").Select
Sheets("Acumulacion").Select
Range("E7:E9").Select
Range("E9").Activate
Selection.ClearContents
Range("E11:E12").Select
Selection.ClearContents
Range("E7").Select
Selection.ClearContents
Range("E8").Select
Selection.ClearContents
Range("E9").Select
Selection.ClearContents
Range("E11").Select
Selection.ClearContents
Range("E12").Select
Selection.ClearContents
Application.ScreenUpdating = True
End Sub
FORMULARIO DE GUARDARA…….
MODULO 1
Sub Fecha()
Application.ScreenUpdating = False
Range("D13").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("D13").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D14").Select
Application.CutCopyMode = False
Selection.ClearContents
Application.ScreenUpdating = True
End Sub
Sub Limpiar()
Application.ScreenUpdating = False
Range("D12:D19").Select
Selection.ClearContents
Range("D14").Select
Application.ScreenUpdating = True
End Sub
Sub Consecutivo()
Application.ScreenUpdating = False
Range("D12").Select
ActiveCell.FormulaR1C1 = "=R[-11]C[7]+1"
Range("D12").Select
Selection.Copy
Range("D12").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D14").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub Buscar()
Application.ScreenUpdating = False
Range("D13").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-1]C,Registros!R[-6]C[-
2]:R[1048563]C[6],2,0),"""")"
Range("D14").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-2]C,Registros!R[-7]C[-
2]:R[1048562]C[6],3,0),"""")"
Range("D15").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-3]C,Registros!R[-8]C[-
2]:R[1048561]C[6],4,0),"""")"
Range("D16").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-4]C,Registros!R[-9]C[-
2]:R[1048560]C[6],5,0),"""")"
Range("D17").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-5]C,Registros!R[-10]C[-
2]:R[1048559]C[6],6,0),"""")"
Range("D18").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-6]C,Registros!R[-11]C[-
2]:R[1048558]C[6],7,0),"""")"
Range("D19").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(R[-7]C,Registros!R[-12]C[-
2]:R[1048557]C[6],8,0),"""")"
Range("D13:D19").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D12").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub Registrar()
Application.ScreenUpdating = False
Sheets("Registros").Select
Rows("8:8").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Range("B8").Select
Sheets("Principal").Select
Range("D12:D19").Select
Selection.Copy
Sheets("Registros").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Range("J8").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Activo"
Range("A1").Select
Sheets("Principal").Select
Range("D12").Select
Application.ScreenUpdating = True
End Sub
BOTON GUARDAR
Sub Guardar()
existe = False
For Each D In Range("D14:D16")
If D.Value = "" Then
celdas = celdas & " " & D.Address(False, False)
existe = True
End If
Next
If existe Then
MsgBox "Falta información obligatoria en las celdas : " & celdas 'mensaje
Exit Sub
End If
Set h1 = Sheets("Principal")
Set h2 = Sheets("Registros")
'
If h1.[D14] = "" Then
MsgBox "Falta colocar el código en la celda D14", vbExclamation, "GUARDAR"
Exit Sub
End If
Set h1 = Sheets("Principal")
Set h2 = Sheets("Registros")
'
If h1.[D16] = "" Then
MsgBox "Falta colocar el código en la celda D16", vbExclamation, "GUARDAR"
Exit Sub
End If
Consecutivo
Fecha
Registrar
Limpiar
End Sub
BOTON ELIMINAR
Sub ELIMINAR()
Dim lista As New Collection
'
Set h1 = Sheets("principal")
Set h2 = Sheets("registros")
'
dato = h1.[D12]
If dato = "" Then
MsgBox "Colocar número de registro"
End If
'
u = h2.Range("B" & Rows.Count).End(xlUp).Row
'
existe = False
For i = 2 To u
If UCase(h2.Cells(i, "B")) = UCase(dato) Then
existe = True
lista.Add i
End If
Next i
Buscar
If existe Then
cf = MsgBox("Desea eliminar el registro con el n° de registro: " & Range("D12"),
vbInformation + vbYesNo, "AVISO")
If cf = vbYes Then
Set r = h2.Columns("B")
Set b = r.Find(h1.[D12], lookat:=xlWhole)
Limpiar
End Sub
BOTON REMPLAZAR
Sub Reemplazar()
Set h1 = Sheets("principal")
Set h2 = Sheets("registros")
'
Set r = h2.Columns("B")
Set b = r.Find(h1.[D12], lookat:=xlWhole)
Limpiar
End If
End Sub
ACCES
LOGIN
Private Sub Comando1_Click()
Dim UserLevel As Integer
If IsNull(Me.txtUsuario) Then
MsgBox "Por favor, escriba su Usuario", vbInformation, "Usuario requerido"
Me.txtUsuario.SetFocus
ElseIf IsNull(Me.txtPass) Then
MsgBox "Por favor, ingrese su Contraseña", vbInformation, "Contraseña
requerida"
Me.txtPass.SetFocus
Else
If (IsNull(DLookup("[Usuario]", "Usuarios", "[Usuario] ='" & Me.txtUsuario.Value
&_
"' And Pass = '" & Me.txtPass.Value & "'"))) Then
MsgBox "Usuario y/o Contraseña incorrectos"
Else
UserLevel = DLookup("Nivel_Seguridad", "Usuarios", "Usuario = '" &
Me.txtUsuario.Value & "'")
If UserLevel = 1 Then
DoCmd.Close
MsgBox "Bienvenido!!!", , "Administrador"
Else
DoCmd.OpenForm "Facturar"
MsgBox "Inicie", , "User"
End If
End If
End If
End Sub
MENU
Private Sub Comando10_Click()
Application.Quit
End Sub