productob = Me.txt_producto.
Value
marcab = Me.txt_marca.Value
tallab = Me.txt_talla.Value
colorb = Me.txt_color.Value
If productob = "" Or marcab = "" Or tallab = "" Or colorb = "" Then
MsgBox ("ingrese producto, marca, talla y color")
Exit Sub
End If
uno = WorksheetFunction.CountIf(Range("C:C"), productob)
dos = WorksheetFunction.CountIf(Range("D:D"), marcab)
tres = WorksheetFunction.CountIf(Range("E:E"), tallab)
cuatro = WorksheetFunction.CountIf(Range("F:F"), colorb)
sumando = uno + dos + tres + cuatro
If sumando = 8 Then
MsgBox ("El registro ya existe")
Asasaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
//Precio de Venta
=BUSCARV([@Codigo];tablap_productos;5;FALSO)
//Precio de Compra
=BUSCARV([@Codigo];tablap_productos;4;FALSO)
=SI(A1="Compras"; BUSCARV([@Codigo];tablap_productos;4;FALSO);BUSCARV([@Codigo];tablap_productos;5;FALSO))
ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
Option Explicit
Private Sub CommandButton1_Click()
Dim i As Integer
With Me.LISTA
aAddItem
For i = 1 To 11
.List(.ListCount - 1, i - 1) = Me.Controls("TexttBox" & i).Value
Next i
End Sub
Private Sub UserForm_Initialize()
With Me.LISTA
.ColumnCount = 11
.List = Range(Cells(8, 8), Cells(1, .ColumnCount)).Value
.RemoveItem 0
End With
End Sub
jjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjjj
Private Sub PRONOMBRE_Initialize()
PRONOMBRE.ListBox1.List = Hoja1.Range("B8:M" & Hoja1.Range("B" & Rows.Count).End(3).Row).Value
End Sub
Kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk
PARA EVITAR REGISTRO DUPLICADO
producto = Me.txt_producto.Value
uno = WorksheetFunction.CountIf(Range("C:C"), producto)
sumando = uno
If sumando = 1 Then
MsgBox ("el registro ya existe")
Else
Fffffffffffffffffffffffffffffffffffffffffffffff
FORMULA ELIMINAR
'Dim respuesta As String
'call inputbox_respuesta(me, "*")
respuesta = Application.InputBox("desea eliminar al registro:" & datos, "ingrese clave")
PARA DESAPARECER LA VENTANA O ESCONDER
Unload Me
Sdsdsdsdsdd
PARA BUSQUEDAS Y DAR ENTER
Private Sub txt_busqueda_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then
BUSQUEDA AL ESCRIBIR
Private Sub txt_busqueda_Change()
numerodedatos = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
LISTA = Clear
LISTA.RowSource = Clear
y=0
For fila = 8 To numerodedatos
productos = ActiveSheet.Cells(fila, 3).Value
If UCase(productos) Like "*" & UCase(Me.txt_busqueda.Value) & "*" Then
Me.LISTA.AddItem
Me.LISTA.List(y, 0) = ActiveSheet.Cells(fila, 2).Value
Me.LISTA.List(y, 1) = ActiveSheet.Cells(fila, 3).Value
Me.LISTA.List(y, 2) = ActiveSheet.Cells(fila, 4).Value
Me.LISTA.List(y, 3) = ActiveSheet.Cells(fila, 5).Value
Me.LISTA.List(y, 4) = ActiveSheet.Cells(fila, 6).Value
Me.LISTA.List(y, 5) = ActiveSheet.Cells(fila, 7).Value
Me.LISTA.List(y, 6) = ActiveSheet.Cells(fila, 8).Value
Me.LISTA.List(y, 7) = ActiveSheet.Cells(fila, 9).Value
Me.LISTA.List(y, 8) = ActiveSheet.Cells(fila, 10).Value
Me.LISTA.List(y, 9) = ActiveSheet.Cells(fila, 11).Value
y=y+1
End If
Next
End Sub
VENTANA DESPLEGABLE EN EL CASO DE VARIOS NOMBRES
Primera_fila =3
Ultima_fila= hoja2.range(“B” & rows.count). end(xlup).row
For inicio= primera_fila to ultima_fila
Me.txt_area.addItem sheets(“DATOS”).cells(inicio,”B”)
jhjjjjjjjjjjj
Application.ScreenUpdating = False
Sheets("Productos").Select
Range("B8").Select
While ActiveCell.Value <> ""
ActiveCell.Offset(0, 50).Select
If ActiveCell.Value = 0 Then
ActiveCell.Offset(0, -50).Select
Wend
Jjjjjjjjjjjjjjjjjjjjjjjjjj
While ActiveCell.Value <> ""
M = InStr(1, UCase(ActiveCell.Value), UCase(PRONOMBRE.Text))
If M > 0 Then
ActiveCell.Offset(0, -1).Select
LISTA.List(LISTA.ListCount - 1, 0) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 1) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 2) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 3) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 4) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 5) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 6) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 7) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 8) = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
LISTA.List(LISTA.ListCount - 1, 9) = ActiveCell.Value
ActiveCell.Offset(0, -8).Select
End If
ActiveCell.Offset(1, 0).Select
Wend
Buscarrrrrrrrrrrrrrrrrrrr
numerodedatos = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
LISTA = Clear
LISTA.RowSource = Clear
y=0
For fila = 8 To numerodedatos
Productos = ActiveSheet.Cells(fila, 3).Value
If UCase(Productos) Like "*" & UCase(Me.PRONOMBRE.Value) & "*" Then
Oooo
If nombre Like "*" & Me.PRONOMBRE.Value & "*" Then
Me.LISTA.AddItem
Me.LISTA.List(y, 0) = ActiveSheet.Cells(fila, 2).Value
Me.LISTA.List(y, 1) = ActiveSheet.Cells(fila, 3).Value
Me.LISTA.List(y, 2) = ActiveSheet.Cells(fila, 4).Value
Me.LISTA.List(y, 3) = ActiveSheet.Cells(fila, 5).Value
Me.LISTA.List(y, 4) = ActiveSheet.Cells(fila, 6).Value
Me.LISTA.List(y, 5) = ActiveSheet.Cells(fila, 7).Value
Me.LISTA.List(y, 6) = ActiveSheet.Cells(fila, 8).Value
Me.LISTA.List(y, 7) = ActiveSheet.Cells(fila, 9).Value
Me.LISTA.List(y, 8) = ActiveSheet.Cells(fila, 10).Value
Me.LISTA.List(y, 9) = ActiveSheet.Cells(fila, 11).Value
y=y+1
End If
Next
End If
Sheets("Movimientos").Select
Range("A1").Select
Application.ScreenUpdating = True
aaaaaaaaaaa
LISTA = Clear
LISTA.RowSource = Clear
Application.ScreenUpdating = False
Sheets("Productos").Select
Buscar en ventana
Application.ScreenUpdating = True
If KeyCode = 13 Then
numerodedatos = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
LISTA = Clear
LISTA.RowSource = Clear
y=0
For fila = 8 To numerodedatos
Productos = Hoja2.Cells(fila, 3).Value
If UCase(Productos) Like "*" & UCase(Me.PRONOMBRE.Value) & "*" Then
Me.LISTA.AddItem
Me.LISTA.List(y, 0) = ActiveSheet.Cells(fila, 2).Value
Me.LISTA.List(y, 1) = ActiveSheet.Cells(fila, 3).Value
Me.LISTA.List(y, 2) = ActiveSheet.Cells(fila, 4).Value
Me.LISTA.List(y, 3) = ActiveSheet.Cells(fila, 5).Value
Me.LISTA.List(y, 4) = ActiveSheet.Cells(fila, 6).Value
Me.LISTA.List(y, 5) = ActiveSheet.Cells(fila, 7).Value
Me.LISTA.List(y, 6) = ActiveSheet.Cells(fila, 8).Value
Me.LISTA.List(y, 7) = ActiveSheet.Cells(fila, 9).Value
Me.LISTA.List(y, 8) = ActiveSheet.Cells(fila, 10).Value
Me.LISTA.List(y, 9) = ActiveSheet.Cells(fila, 11).Value
y=y+1
End If
Next
End If
GRABAR MOVIMIENTOS
Sub grabar_movimiento()
Application.ScreenUpdating = False
'
' grabar_movimiento Macro
'
'
Rows("20:20").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("C7").Select
Selection.Copy
Range("B20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "m/d/yyyy"
Range("C8").Select
Selection.Copy
Range("C20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C9").Select
Application.CutCopyMode = False
Selection.Copy
Range("D20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C10").Select
Application.CutCopyMode = False
Selection.Copy
Range("E20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C11").Select
Application.CutCopyMode = False
Selection.Copy
Range("F20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C12").Select
Application.CutCopyMode = False
Selection.Copy
Range("G20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C13").Select
Application.CutCopyMode = False
Selection.Copy
Range("H20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C14").Select
Application.CutCopyMode = False
Selection.Copy
Range("I20").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C15").Select
Application.CutCopyMode = False
Selection.Copy
Range("J20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C16").Select
Application.CutCopyMode = False
Selection.Copy
Range("K20").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C7").Select
If Sheets("Movimientos").Range("C10") = "Compras" Then
grabar_compras
End If
If Sheets("Movimientos").Range("C10") = "Ventas" Then
grabar_ventas
End If
If Sheets("Movimientos").Range("C10") = "Ventas Credito" Then
grabar_ventas_credito
End If
MENSAJE DE ERRORES
On error goto manejadorerrores
Exit sub
Manejadorerrores:
Msgbox”ingresa valores numericos”
On Error GoTo ManejadorErrores
constante = "hoja" & i
Exit Sub
ManejadorErrores:
If ERR.Number = 9 Then
MsgBox "la hoja:" & constante & "no existe."
Else
MsgBox "ha ocurrido un error: " & ERR.Description
End If
Dddddddddddddddddddddddddddddddddddddddddddddddddddddddd
MODIFICAR LIBRO DESDE OTRO LIBRO EXCEL (VBA)
Private Sub CommandButton1_Click()
Dim objExcel As Application
Dim RutaArchivo As String
Dim Texto As String
Dim Fila As Integer
Dim Final As Integer
Dim Celda As Object
Texto = "Espere un momento... Procesando la información"
Application.StatusBar = Texto
Set objExcel = CreateObject("Excel.Application")
With objExcel
For Each Celda In Selection
RutaArchivo = ThisWorkbook.Path & Celda.Value
If IsFileOpen(RutaArchivo) Then
MsgBox "El libro debe estar cerrado para proceder."
Exit Sub
Else
'
With .Workbooks.Open(RutaArchivo)
For Fila = 2 To 1000
If .Worksheets("Hoja1").Cells(Fila, 1) = "" Then
Final = Fila
Exit For
End If
Next
.Worksheets("Hoja1").Cells(Final, 1) = Me.TextBox1
.Worksheets("Hoja1").Cells(Final, 2) = Me.TextBox2
.Close SaveChanges:=True
End With
End If
'
Next Celda
.Quit
End With
Call LiberarBarra
MsgBox "Información procesada con éxito!"
Me.TextBox1 = ""
Me.TextBox2 = ""
End Sub
