[Resolvido]Setar Registro no SubFormulario

Bom so por questão de estudo e capricho gostaria da ajuda do pessoal na questao,
tenho um formulario e um subformulario ele ja verifica se o produto já esta incluido atraves da consulta e pelo id do produto porem o que eu queria se fosse possivel setar a linha do produto pelo id_produto sei e ja fiz isso quando e listbox mais em subformulario ainda nao para listbox algo do tipo.

contador = 0

For Linha = 0 To Lista_Selecionados.ListCount - 1

'If Lista_Selecionados.Column(4, Linha) = Me.txtpesq1 Then
If InStr(Lista_Selecionados.Column(4, Linha), Me.txtpesq1) Then
Lista_Selecionados.Selected(Linha) = True
contador = contador + 1
Else
Lista_Selecionados.Selected(Linha) = False
End If
Next

ele seta mais para sub ainda nao fiz e nao vi nada parecido exemplo

tenho o campo no subformulario que fica o id do produto e um botao para adicionar ai faco a verificação de item ja adicionado.

ElseIf DCount("*", "Temp_Compra_Sub", "id_produto = " & Me.Id_Produto) > 0 Then
MsgBox "Produto: (" & Me.produto & ") Já Adicionado, Para Adicionar Mais do Mesmo Produto, Delete o Anterior e Aumente a Quantidade", vbExclamation, Titulo
Me.Id_Produto = Empty
Me.produto = Empty
Me.Valor_Unit = Empty
Me.qtd_produto = 1
Me.desconto = 0
Me.Id_Produto.SetFocus
Exit Sub


ai antes de zero os campo queria que ele setasse a linha em que esta o produto duplicado.
desde ja agradeço se alguém pude me ajudar

Marcelo3092, veja o exemplo

'If Lista_Selecionados.Column(4, Linha) = Me.txtpesq1 Then


'If NomeForm!NomeSubForm.form.Lista_Selecionados.Column(4, Linha) = Me.txtpesq1 Then

Você tem que referenciar o formulário que contém o subformulário e depois acrescentar a palavra "form" antes do nome do controle

Boa sorte!

Bom dia caique eu dei so um exemplo de como se faz com listbox porem meu caso e um subformulario continuo modo folha de dados e nao uma listbox.

Bom dia.

É possível você enviar uma cópia do banco de dados?

Caique ate mandava pra vc porem eu to fazendo ele pra usa online e ai to rodando um banco mysql com xampp se vc ja uso eu mando pra vc ele vai ser usado online o banco

Marcelo, pode mandar apenas os formularios para poder entender melhor o problema...

Acho que entendi

Se com setar você quer dizer selecionar, então aí vai...

Crie um procedimento público no subformulário com o seguinte código

Código:

Public Sub fncSelecionaRegistro(ByVal strCondicao As String)

    Dim objRs As DAO.Recordset
   
    Set objRs = Me.Recordset
    Call objRs.FindFirst(strCondicao)
   
    If Not objRs.NoMatch Then
        Parent("NomeDoControleNoFormulárioPai").SetFocus
        Call DoCmd.RunCommand(acCmdSelectRecord)
    End If
   
    Set objRs = Nothing
   
End Sub

Daí a chamada seria, por exemplo

Código:

Me("NomeDoControleNoFormulárioPai").Form.fncSelecionaRegistro ("cpNome = 'Damasceno'")

Boa noite Grande Damasceno, consegui fazendo algumas alterações so pra deixa explicado esse é o código que eu uso para adicionar um produto na lista porem ele faz a verificação se ja existe, e se por acaso tiver mais de um produto ele selecionar na lista para poder deleta e adicionar mais de um ficou assim

Dim CalculoDesconto
Dim CalculoDesc As Double
vgIdOs = Me.id_os


DoEvents
Call Consulta_Estoque
DoEvents


CalculoDesconto = Me.SubTotal_P / Me.qtd_produto
CalculoDesc = (Me.SubTotal_P / Me.qtd_produto)

If IsNull(Me.Id_Produto) Then
MsgBox "Nenhum Produto Selecionado.", vbExclamation, Titulo
Me.Id_Produto.SetFocus
Exit Sub


ElseIf DCount("*", "Temp_OS_Produto", "id_produto = " & Me.Id_Produto) > 0 Then
MsgBox "Produto: (" & Me.produto & ") Já Adicionado, Delete o Item Selecionado e Adicione Novamente com Maior Quantidade.", vbExclamation, Titulo

Me.Frm_OS_Produtos.Form.fncSelecionaProduto ("id_produto = " & Me.Id_Produto & "")

Me.Id_Produto = Empty
Me.produto = Empty
Me.Valor_Unit_P = Empty
Me.qtd_produto = 1
Me.Desconto_P = 0
Me.Id_Produto.SetFocus
Exit Sub

ElseIf CalculoDesconto < Me.txtlimitedesconto Then
'MsgBox "Desconto Acima do Permitido Para Este Produto Limite Maximo Por Produto: (" & Format(Me.txtlimitedesconto, "#,##0.00") & ").", vbCritical, Titulo
MsgBox "Desconto Acima do Permitido Para Este Produto Limite Maximo Por Produto:" & vbCr & _
"Desconto Aplicado R$: " & Format(CalculoDesc, "#,##0.00") & vbCr & _
"Limite de Desconto R$: " & Format(txtlimitedesconto, "#,##0.00") & vbCr & _
"Verifique o Desconto Informado.", vbCritical, Titulo
Me.Desconto_P = 0
Me.Desconto_P.SetFocus
Exit Sub


ElseIf p_qtd_estoque < Me.qtd_produto Then
' MsgBox "O Produto Selecionado " & Me.produto & "Está com o Estoque Abaixo do Desejado Estoque Atual.", vbCritical, Titulo
MsgBox "O Produto Selecionado Esta com Estoque Abaixo do Desejado:" & vbCr & _
"Produto Desejado: " & Me.produto & vbCr & _
"Quantidade Desejada: " & Me.qtd_produto & vbCr & _
"Estoque Atual: " & p_qtd_estoque, vbCritical, Titulo
Me.qtd_produto = 1
Me.qtd_produto.SetFocus
Exit Sub



Else

DoCmd.Hourglass True
'Me.BTADDSERVICO.enabled = False
'vgIdCandidato = Me.id_candidato

DoEvents
Call Gravar_Produto
DoEvents
Call Carrega_Produto
DoEvents
Call Calc
qtd_produto = 1
Frm_OS_Produtos.Requery
'Me.BTADD2.enabled = True
DoCmd.Hourglass False
End If

e a sub

Public Sub fncSelecionaProduto(ByVal strCondicao As String)

Dim objRs As DAO.Recordset

Set objRs = Me.Recordset
Call objRs.FindFirst(strCondicao)

If Not objRs.NoMatch Then
Parent("produto").SetFocus
Call DoCmd.RunCommand(acCmdSelectRecord)
End If

Set objRs = Nothing

End Sub

O fórum agradece o retorno. Sucesso.