Formulario de consulta

[jeanette27]

Tengo el siguiente código:

Private Sub CommandButton1_Click()
Dim xCodigo As String, xApDcto As String
Dim xFila As Integer, xDcto As Integer, xLargo As Integer
Dim resp As Boolean
On Error Resume Next
xCodigo = frmConsulta.TextBox1.Value
xLargo = Len(Trim(xCodigo))
If xLargo = 1 Then xCodigo = "000" & xCodigo:  frmConsulta.TextBox1.Value = xCodigo
If xLargo = 2 Then xCodigo = "00" & xCodigo: frmConsulta.TextBox1.Value = xCodigo
If xLargo = 3 Then xCodigo = "0" & xCodigo: frmConsulta.TextBox1.Value = xCodigo
    Hoja1.Select
    Range("A2").Select
    resp = Cells.Find(What:=xCodigo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Activate
'  Cells.FindNext(After:=ActiveCell).Activate
    If resp = False Then
        MsgBox "No hay Producto", , "El codigo no se encuentra en la lista  Columna  A"
        Me.TextBox1.Value = ""
    Else
        xFila = ActiveCell.Row
        xApDcto = Hoja1.Cells(xFila, 4).Value
        If Me.OptionButton1.Value = True Then
            xDcto = 10
        Else
            If Me.OptionButton2.Value = True Then
                xDcto = 20
            Else
                If Me.OptionButton3.Value = True Then
                    xDcto = 30
                End If
            End If
        End If
        If xApDcto = "S" Then
            Me.TextBox2.Value = "S/. " & Hoja1.Cells(xFila, 3).Value
            Me.TextBox4.Value = "S/. " & (Hoja1.Cells(xFila, 3).Value) - (((Hoja1.Cells(xFila, 3).Value) * xDcto) / 100)
            Me.TextBox3.Value = Hoja1.Cells(xFila, 2).Value
        Else
            MsgBox "No Aplica Descuento", , "Cuando se elige  producto sin descuento: ( N ) columna  D"
            Me.TextBox1.Value = ""
        End If
    End If

End Sub[/PHP]

FUNCIONA PERFECTO el Problema q tengo es: he creado un botón en la hoja2(intro) se abre el form en la misma hoja, pero al consultar me pasa el form a la hoja1(base de datos) que tengo q hacer para q la consulta ME haga en la hoja2(intro) donde he creado el boton

[AlexanderS]

Hola @[uSER=166978]jeanette27[/uSER], recuerda que siempre debes subir un archivo de ejemplo para que nos sea mas fácil ayudarte.

En todo caso en esta parte del código:

 Hoja1.Select' <<<<<<<<Aquí<<<<<<<<<<<<<<<<

    Range("A2").Select[/CODE]

Estas seleccionando la hoja1, borra esa parte o cambialo por el nombre de la hoja en que quieres que se ejecute el código.

Salu2

[jeanette27]

gracias por su respuesta..... si lo hice pero me busca en la hoja2 y no encuentra nada

lo que hice fue aumentar esto al final del procedimiento

    Else
            MsgBox "No Aplica Descuento", , "Cuando se elige  producto sin descuento: ( N ) columna  D"
            Me.TextBox1.Value = ""
        End If
    End If
    Sheets("intro").Activate    <<<<<<<<<-------
End Sub [/PHP]

funciona ....pero al consultar hace como un parpadeo (cambio) entre las hojas 1 y 2 como hago para que no haga eso.....

[pajuma]

Application.ScreenUpdating = False

colocalo al comienzo de tu codigo.

Saludos,

[Antoni]

Añade Application.ScreenUpdating = False al principio del procedimiento.

Saludos @[uSER=143023]Riddle[/uSER] y perdona la intromisión.

[Freddyasz1]

Hola..

si quieres prueba este código y revisa que ya no te debe parpadear las hojas..

Private Sub CommandButton1_Click()

Dim xCodigo As String, xApDcto As String

Dim xFila As Integer, xDcto As Integer, xLargo As Integer

Dim resp As Boolean

On Error Resume Next

xCodigo = frmconsulta.TextBox1.Value

xLargo = Len(Trim(xCodigo))

If xLargo = 1 Then xCodigo = "000" & xCodigo: frmconsulta.TextBox1.Value = xCodigo

If xLargo = 2 Then xCodigo = "00" & xCodigo: frmconsulta.TextBox1.Value = xCodigo

If xLargo = 3 Then xCodigo = "0" & xCodigo: frmconsulta.TextBox1.Value = xCodigo

With ActiveSheet

Range("A2").Select

resp = Cells.Find(What:=xCodigo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Activate

' Cells.FindNext(After:=ActiveCell).Activate

If resp = False Then

MsgBox "No hay Producto", , "El codigo no se encuentra en la lista Columna A"

Me.TextBox1.Value = ""

Else

xFila = ActiveCell.Row

xApDcto = .Cells(xFila, 4).Value

If Me.OptionButton1.Value = True Then

xDcto = 10

Else

If Me.OptionButton2.Value = True Then

xDcto = 20

Else

If Me.OptionButton3.Value = True Then

xDcto = 30

End If

End If

End If

If xApDcto = "S" Then

Me.TextBox2.Value = "S/. " & .Cells(xFila, 3).Value

Me.TextBox4.Value = "S/. " & (.Cells(xFila, 3).Value) - (((.Cells(xFila, 3).Value) * xDcto) / 100)

Me.TextBox3.Value = .Cells(xFila, 2).Value

Else

MsgBox "No Aplica Descuento", , "Cuando se elige producto sin descuento: ( N ) columna D"

Me.TextBox1.Value = ""

End If

End If

End With

End Sub