La Web del Programador: Comunidad de Programadores
https://www.lawebdelprogramador.com/foros/Visual-Basic/1122681-Traer-el-registro-al-ingresar-el-IDPROD.html

Traer el registro al ingresar el IDPROD

Traer el registro al ingresar el IDPROD

Publicado por Pablo (2 intervenciones) el 10/07/2009 23:03:43
Tengo un problema que no logro solucionar, necesito ingresar en modo de ejecucion el IDProducto y que me traiga el resto del registro a otros controles un combo y otros tres textbox. Actualmente puedo desplegar el combo y elegir el producto o con un command hago la busqueda, pero necesito ingresar tambien por codigo de producto. Aca va lo que tengo y FUNCIONA.
MODULO PRINCIPAL
Public Sub P_RellenaCombo(ByVal CRITERIO As String, ByRef XCOMBO As Object, Optional DATO As String, Optional ByVal NOLIMPIAR As Integer = 0)
On Local Error GoTo L
Dim rs As New ADODB.Recordset
ElseIf CRITERIO = "PROD" Then
rs.Open "SELECT Categorias.descategoria+' '+ Marcas.desmarca+' '+ Productos.nombre,Idproducto FROM Marcas INNER JOIN (Categorias INNER JOIN Productos ON Categorias.idcategoria = Productos.idcategoria) ON Marcas.idmarca = Productos.idmarca", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
REFRESCAR rs
If NOLIMPIAR = 0 Then
XCOMBO.Clear
End If
If rs.RecordCount = 0 Then
Set rs = Nothing
Exit Sub
End If
Do While rs.EOF = False
XCOMBO.AddItem rs(0)
If CRITERIO = "PROD" Then
XCOMBO.ItemData(XCOMBO.NewIndex) = Val(rs(1))
End If
rs.MoveNext
Loop
Set rs = Nothing
Exit Sub
L:
MsgBox Err.Description, vbCritical
End Sub
Public Sub BuscarEnCombito(ByRef CMB As Object)
On Local Error Resume Next
Dim j As Byte
Dim I As Long
For I = 0 To CMB.ListCount - 1
If CMB = CMB.List(I) Then
j = 1
CMB.ListIndex = I
Exit Sub
Else
j = 2
End If
Next I
If j = 2 Then
On Error Resume Next
CMB = ""
CMB.ListIndex = 0
End If
On Local Error GoTo 0
End Sub
Public Sub ValidarIngreso1(ByRef cbCombo As ComboBox, ByRef iKey As Integer, Optional ByRef cControl As Control)
On Error GoTo ERROR
Dim cbE As Long, FindString$
Const Cb_FinsdString = &H14C
iKey = Asc(UCase(Chr(iKey)))
If iKey = 8 Then 'SI TECLEA BACKSPACE********************************************************************************
If Len(Trim(cbCombo.Text)) = 1 Or cbCombo.SelLength = Len(Trim(cbCombo.Text)) Then
cbCombo.ListIndex = 0: Exit Sub
End If
End If
If cbCombo.SelLength = 0 Then 'SE ASIGNA VALORES A LA CADENA A BUSCAR(FINDSTRING)************************************
FindString = cbCombo.Text & Chr$(iKey)
Else
FindString = Left$(cbCombo.Text, cbCombo.SelStart) & Chr$(iKey)
End If
cbE = SendMessage(cbCombo.hwnd, Cb_FinsdString, -1, ByVal FindString)
If iKey = 13 Then 'SI TECLEA DoEvents
cControl.SetFocus
If cbE = -1 Then cbE = cbCombo.ListIndex
If cbCombo.ListIndex = -1 Then Exit Sub
If cbCombo.ListIndex > -1 Then cbE = cbCombo.ListIndex
End If
'If iKey < 32 Or iKey > 127 Then Exit Sub
If cbE <> -1 Then
cbCombo.ListIndex = cbE 'SUELE LLAMAR AL EVENTO CLICK O CHANGE
cbCombo.SelStart = Len(FindString)
cbCombo.SelLength = Len(cbCombo.Text) - cbCombo.SelStart
End If
If iKey = 13 Then cbCombo.SelLength = 0 'EN
iKey = 0: Exit Sub
ERROR:
Exit Sub
End Sub
Function precioPRO(codprod As String) As Double
On Local Error GoTo L
Dim T As New ADODB.Recordset
T.Open "SELECT precio FROM productos WHERE idproducto='" + codprod + "'", cn, adOpenForwardOnly, adLockReadOnly
REFRESCAR T
If T.RecordCount = 0 Then
Set T = Nothing
precioPRO = 0
Exit Function
End If
precioPRO = T(0)
Set T = Nothing
Exit Function
L:
MsgBox Err.Description, vbCritical
End Function
Public Function DevuelveIdProducto(prods As String) As String
On Local Error GoTo L
Dim T As New ADODB.Recordset
T.Open "SELECT Productos.idproducto FROM Marcas INNER JOIN (Categorias INNER JOIN Productos ON Categorias.idcategoria = Productos.idcategoria) ON Marcas.idmarca = Productos.idmarca where categorias.descategoria+' '+ Marcas.desmarca+' '+ Productos.nombre='" + prods + "'", cn, adOpenForwardOnly, adLockReadOnly, adCmdText
REFRESCAR T
If T.RecordCount = 0 Then
DevuelveIdProducto = ""
Set T = Nothing
End If
DevuelveIdProducto = T!idproducto
Set T = Nothing
Exit Function
L:
MsgBox Err.Description
End Function

FRMFacturacion

Private Sub cmbproducto_Click()
If cmbproducto = "" Then
Exit Sub
End If
txtidproducto = DevuelveIdProducto(cmbproducto)
TXTprecio = Format$(precioPRO(txtidproducto), "###0.00")
txtcantidad = "0"
End Sub
Private Sub cmbproducto_KeyPress(KeyAscii As Integer)
ValidarIngreso1 cmbproducto, KeyAscii
End Sub

Espero sirva, si me pudieran decir ademas en que evento del textbox debiera modificar para que funcione, ingresar codigo producto dar enter o tab y que me traiga el resto del registo, debe ser simple pero no lo puedo hacer.
Gracias

RE:Traer el registro al ingresar el IDPROD

Publicado por JaImE GuErReRo (361 intervenciones) el 16/07/2009 23:33:29
el metodo del textbox puede ser el lost focus

para buscar seria

select * from tabla where campo='& textbox1.text & '

RE:Traer el registro al ingresar el IDPROD

Publicado por Julio Aguilar (69 intervenciones) el 24/07/2009 23:52:26
cerca.

select * from tabla where campo like '& textbox1.text & '