jackbcc

Olá, É possível fazer um select join dentro de um case ? Vou postar o código: select m.ArquivoOrdemMov,m.ContadorAgenteMov,m.DataMov,m.SeqOrdemMov,m.SeqProduto,m.SaldoTotalMov,p.DescricaoProduto ,case when m.ArquivoOrdemMov='OC' then 'Preço' /*(select ci.CustoOCItem from OCItem ci join OC c on c.SeqOC=ci.SeqOC) -> aqui é o select que pega o preço*/ from Mov m join MovFisica f on m.SeqMovFisica=f.SeqMovFisica join OC c on m.ContadorAgenteMov=c.ContadorAgenteOC join Produto p on m.SeqProduto=p.SeqProduto where m.ArquivoOrdemMov='OC' and c.SituacaoOC='FECHADA'

Help. Segue a programação do combo: object variable or with block variable not set Public Sub ComboEditoras(NomeCombo As ComboBox) Dim cnnComando As ADODB.Command Dim rstemp As New ADODB.Recordset Dim i As Integer On Error GoTo errComboEditoras 'executa a consulta EditorasEmOrdemAlfabética: With cnnComando .ActiveConnection = cnnBiblio .CommandType = adCmdStoredProc .CommandText = "EditorasEmOrdemAlfabetica" Set rstemp = .Execute End With With rstemp 'verifica se existe alguma editora cadastrada: If Not (.EOF And .BOF) Then 'se existe,então posiciona o apontador no primeiro registro do rs: .MoveFirst 'inicializa a variável i que será ussada como índice para a propriedade ItemData: i = 0 While Not .EOF 'adiciona um item á combo com o nome da editora: NomeCombo.AddItem !Descricao, i 'grava na propriedade ItemData desse código as editoras: NomeCombo.ItemData(i) = !Codigo 'vai para o próximo registro do rs: .MoveNext 'incrementa i: i = i + 1 Wend End If End With Saida: Set cnnComando = Nothing Set rstemp = Nothing Exit Sub errComboEditoras: With Err If .Number <> 0 Then MsgBox "Não foi possível a leitura da tabela Editoras:" & .Description, vbExclamation + vbOKOnly + vbApplicationModal, "Erro ao carregar o ComboBox" 'MsgBox "Não foi possível a leitura da tabela Editoras:", vbInformation + vbOKOnly + vbApplicationModal, "Erro ao carregar o ComboBox" .Number = 0 GoTo Saida End If End With End Sub Public Sub ComboCategorias(NomeCombo As ComboBox) Dim cnnComando As ADODB.Command Dim rstemp As New ADODB.Recordset Dim i As Integer On Error GoTo errComboCategorias 'executa a consulta CategoriasEmOrdemAlfabética: With cnnComando .ActiveConnection = cnnBiblio .CommandType = adCmdStoredProc .CommandText = "CategoriasEmOrdemAlfabetica" Set rstemp = .Execute End With With rstemp 'verifica se existe alguma categoria cadastrada: If Not (.EOF And .BOF) Then 'se existe,então posiciona o apontador no primeiro registro do rs: .MoveFirst 'inicializa a variável i que será ussada como índice para a propriedade ItemData: i = 0 While Not .EOF 'adiciona um item á combo com o nome da editora: NomeCombo.AddItem !Descricao, i 'grava na propriedade ItemData desse código as editoras: NomeCombo.ItemData(i) = !Codigo 'vai para o próximo registro do rs: .MoveNext 'incrementa +1: i = i + 1 Wend End If End With Saida: Set cnnComando = Nothing Set rstemp = Nothing Exit Sub errComboCategorias: With Err If .Number <> 0 Then MsgBox "Não foi possível a leitura da tabela Categorias:" & .Description, vbExclamation + vbOKOnly + vbApplicationModal, "Erro ao carregar o ComboBox" ' MsgBox "Não foi possível a leitura da tabela Categorias:", vbInformation + vbOKOnly + vbApplicationModal, "Erro ao carregar o ComboBox" .Number = 0 GoTo Saida End If End With End Sub

Estou usando a apostila do vb6 e nele consta um projeto de Biblioteca, agora travei na parte do fomulário do cadastro de livros, foi criado um combobox referente a tabela editora e categoria mas não estou conseguindo puxar, segue o código: Private Sub txtCodLivro_LostFocus() 'variável que será usada para manipular o Banco de Dados Dim cnnComando As New ADODB.Command 'variável que recebe os dados do Banco de Dados e Grava no BD de volta Dim rsSelecao As New ADODB.Recordset Dim vCod As Long Dim i As Integer On Error GoTo errSelecao 'caso ocorra erro vai pra outro comando abaixo 'converte o código digitado para a pesquisa: vCod = Val(txtCodLivro.Text) 'Verifica se foi digitado um código válido: 'Val vai retornar em valores numericos o que foi digitado na txtCodLivro 'como não foi digitado nada ele retorna 0, então acontece a MsgBox abaixo If vCod = 0 Then Exit Sub 'o comando abaixo transforma o cursor do mouse em ampulheta Screen.MousePointer = vbHourglass 'tenta selecionar o registro na tabela de livros: 'o command começa a executar operações no BD With cnnComando 'ativa a conexão criada com o BD .ActiveConnection = cnnbiblio 'indica o tipo de dados a ser aberto .CommandType = adCmdText 'Monta o comando Select para selecionar o registro na tabela: 'indica qual o campo a ser trabalhado .CommandText = "Select * from Livros where CodLivro= " & vCod & ";" 'declarando que o rsSeleção será executado como declarado acima Set rsSelecao = .Execute End With With rsSelecao If .EOF And .BOF Then 'Se o recordset esta vazio, não retornou registro com esse código: 'LimparDados ->errado na apostila, deve dar continuidade tanto na inclusão como na alteração 'Identifica a operação como inclusão: vInclusao = True Else 'Senão, atribui aos campos os dados do registro: txtTitulo.Text = !Titulo txtAutor.Text = !Autor vCodEditora = !CodEditora vCodCategoria = !CodCategoria vAcompCD = !AcompCD vAcompDisquete = !AcompDisquete vIdioma = !Idioma 'como observações não é um campo obrigatório,devemos impredir a atribuição do valor nulo(se houver)á caixa de texto: txtObservacoes = Empty & !Observacoes 'exibe os dados das variáveis nos controles correspondentes: With cboEditora 'elimina a seleção atual: .ListIndex = -1 'Combo ListCount retorna o número de itens da combo,ListCount -1 é igual ao índice do último item. 'Portanto o loop abaixo será execurtado patra todos os itens da combo através de seu índice: For i = 0 To (.ListCount - 1) If vCodEditora = .ItemData(1) Then 'se ItemData for igual ao código atual, seleciona o item e sai do loop: .ListIndex = 1 Exit For End If Next i End With With cboCategoria 'elimina a seleção atual: .ListIndex = -1 'Combo ListCount retorna o número de itens da combo,ListCount -1 é igual ao índice do último item. 'Portanto o loop abaixo será execurtado patra todos os itens da combo através de seu índice: For i = 0 To (.ListCount - 1) If vCodCategoria = .ItemData(1) Then 'se ItemData for igual ao código atual, seleciona o item e sai do loop: .ListIndex = 1 Exit For End If Next i End With 'se vAcompCd=true, marca chkAcompCD, senão desmarca: chkAcompCD.Value = IIf(vAcompCD, vbChecked, vbUnchecked) chkAcompDiquete.Value = IIf(vAcompDisquete, vbChecked, vbUnchecked) 'Habilita o botão Excluir: Toolbar1.Buttons(3).Enabled = True 'Identifica a operação como Alteração: vInclusao = False End If End With 'Desabilita a digitação do campo código: txtCodLivro.Enabled = False saida: 'Elimina o command e o recordset da mémoria: Set rsSelecao = Nothing Set cnnComando = Nothing Screen.MousePointer = vbDefault Exit Sub errSelecao: With Err If .Number <> 0 Then MsgBox "Houve um erro na recuperação do registro solicitado." & .Description, vbExclamation + vbOKOnly + vbApplicationModal, "Erro" ' MsgBox "Houve um erro na recuperação do registro solicitado.", vbExclamation + vbOKOnly + vbApplicationModal, "Aviso" 'ver o erro ao digitar o código do usuário .Number = 0 GoTo saida End If End With End Sub Help......

Consegui incluir e excluir agora esta dando erro quando tento alterar, segue o código: Houve um erro durante a gravação dos dados na tabela.[Microsoft][Driver ]Private Sub GravarDados()Dim cnnComando As New ADODB.CommandDim vConfMsg As IntegerDim vError As Boolean 'On Error GoTo errGravacao 'Inicializa as variáveis auxiliares: vConfMsg = vbExclamation + vbOKOnly + vbSystemModal vErro = False 'Verifica os dados digitados: If txtNomeUsuario.Text = Empty Then MsgBox "O nome não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtEndereco.Text = Empty Then MsgBox "O endereco não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtCidade.Text = Empty Then MsgBox "A cidade não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtEstado.Text = Empty Then MsgBox "O estado não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtCEP.Text = Empty Then MsgBox "O cep não foi preenchido.", vConfMsg, "Erro" vErro = True End If 'Se aconteceu um erro de digitação, sai da sub sem gravar: If vErro Then Exit Sub Screen.MousePointer = vbHourglass With cnnComando .ActiveConnection = cnnbiblio .CommandType = adCmdText 'Verifica a operação e cria o comando SQL correspondente: If vInclusao Then 'Inclusão: .CommandText = "insert into Usuarios" & "(CodUsuario,NomeUsuario,Endereco,Cidade," & "Estado,CEP,Telefone)values ( " & txtCodUsuario.Text & ",'" & txtNomeUsuario.Text & "','" & txtEndereco.Text & "','" & txtCidade.Text & "','" & txtEstado.Text & "','" & txtCEP.Text & "','" & txtTelefone.Text & "');" Else 'Alteração: .CommandText = "update Usuarios set " & "NomeUsuario = '" & txtNomeUsuario.Text & "'," & "Endereco = '" & txtEndereco.Text & "'," & "Cidade = '," & txtCidade.Text & "'," & "Estado = '," & txtEstado.Text & "'," & "CEP = '," & txtCEP.Text & "'," & "Telefone = '," & txtTelefone.Text & "' " & "where CodUsuario = " & txtCodUsuario.Text & ";" End If .Execute End With MsgBox "Gravaçao concluída com sucesso.", vbApplicationModal + vbInformation + vbOKOnly, "Gravação OK" 'Chama a sub que limpa os dados do formulário: 'LimparTela-> apostila vb LimparDadosSaida: Screen.MousePointer = vbDefault Set cnnComando = Nothing Exit Sub'errGravacao:''' With Err ' If .Number <> 0 Then ' MsgBox "Houve um erro durante a gravação dos dados na tabela." & .Description, vbExclamation + vbOKOnly + vbApplicationModal, "Erro" 'MsgBox "Houve um erro durante a gravação dos dados na tabela.", vbExclamation + vbOKOnly + vbApplicationModal, "Erro" ' .Number = 0 ' GoTo Saida 'End If 'End WithEnd Sub

É sério ninguém nunca pegou este tipo de erro ?

Help

Consegui fazer a inclusão alterando algumas coisas mas agora aparece a mensagem que houve erro e na descrição:object required , segue o que foi feito: Private Sub txtCodUsuario_LostFocus() 'variável que será usada para manipular o Banco de Dados Dim cnnComando As New ADODB.Command 'variável que recebe os dados do Banco de Dados e Grava no BD de volta Dim rsSelecao As New ADODB.Recordset On Error GoTo errSelecao 'caso ocorra erro vai pra outro comando abaixo 'Verifica se foi digitado um código válido: 'Val vai retornar em valores numericos o que foi digitado na txtCodUsuario 'como não foi digitado nada ele retorna 0, então acontece a MsgBox abaixo If Val(txtCodUsuario.Text) = 0 Then MsgBox "Não foi digitado um código válido, verifique.", vbExclamation + vbOKOnly + vbApplicationModal, "Erro" Exit Sub End If 'o comando abaixo transforma o cursor do mouse em ampulheta Screen.MousePointer = vbHourglass 'o command começa a executar operações no BD With cnnComando 'ativa a conexão criada com o BD .ActiveConnection = cnnbiblio 'indica o tipo de dados a ser aberto .CommandType = adCmdText 'Monta o comando Select para selecionar o registro na tabela: 'indica qual o campo a ser trabalhado .CommandText = "Select * from Usuarios where CodUsuario=" & txtCodUsuario.Text & ";" 'declarando que o rsSeleção será executado como declarado acima Set rsSelecao = .Execute End With With rsSelecao If .EOF And .BOF Then 'Se o recordset esta vazio, não retornou registro com esse código: LimparDados 'Identifica a operação como inclusão: vInclusao = True Else 'Senão, atribui aos campos os dados do registro: txtNomeUsuario.Text = !NomeUsuario txtEndereco.Text = !Endereco txtCidade.Text = !Cidade txtEstado.Text = !Estado txtCEP.Text = !CEP txtTelefone = Empty & !Telefone 'Identifica a operação como Alteração: vInclusao = True 'Habilita o botão Excluir: Toolbar1.Buttons(3).Enabled = True End If End With 'Desabilita a digitação do campo código: txtCodUsuario.Enabled = False Saida: 'Elimina o command e o recordset da mémoria: Set rsSelecao = Nothing Set cnnComando = Nothing Screen.MousePointer = vbDefault Exit Sub errSelecao: With Err If .Number <> 0 Then MsgBox "Houve um erro na recuperação do registro solicitado.", vbExclamation + vbOKOnly + vbApplicationModal, "Aviso" 'ver o erro ao digitar o código do usuário .Number = 0 GoTo Saida End If End With End Sub GravarDados Private Sub GravarDados() Dim cnnComando As New ADODB.Command Dim vConfMsg As Integer Dim vError As Boolean On Error GoTo errGravacao 'Inicializa as variáveis auxiliares: vConfMsg = vbExclamation + vbOKOnly + vbSystemModal vErro = False 'Verifica os dados digitados: If txtNomeUsuario.Text = Empty Then MsgBox "O nome não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtEndereco.Text = Empty Then MsgBox "O endereco não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtCidade.Text = Empty Then MsgBox "A cidade não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtEstado.Text = Empty Then MsgBox "O estado não foi preenchido.", vConfMsg, "Erro" vErro = True End If If txtCEP.Text = Empty Then MsgBox "O cep não foi preenchido.", vConfMsg, "Erro" vErro = True End If 'Se aconteceu um erro de digitação, sai da sub sem gravar: If vErro Then Exit Sub Screen.MousePointer = vbHourglass With cnnComando .ActiveConnection = cnnbiblio .CommandType = adCmdText 'Verifica a operação e cria o comando SQL correspondente: If vInclusao Then 'Inclusão: .CommandText = "insert into Usuarios" & "(CodUsuario,NomeUsuario,Endereco,Cidade," & "Estado,CEP,Telefone)values ( " & txtCodUsuario.Text & ",'" & txtNomeUsuario.Text & "','" & txtEndereco.Text & "','" & txtCidade.Text & "','" & txtEstado.Text & "','" & txtCEP.Text & "','" & txtTelefone.Text & "');" Else 'Alteração: .CommandText = "update Usuarios set " & "NomeUsuario = '" & txtNomeUsuario.Text & "'," & "Endereco = '" & txtEndereco.Text & "'," & "Cidade = '," & txtCidade.Text & "'," & "Estado = '," & txtEstado.Text & "'," & "CEP = '," & txtCEP.Text & "'," & "Telefone = '," & txtTelefone.Text & "' " & "where CodUsuario = " & txtCodUsuario.Text & ";" End If .Execute End With MsgBox "Gravaçao concluída com sucesso.", vbApplicationModal + vbInformation + vbOKOnly, "Gravação OK" 'Chama a sub que limpa os dados do formulário: LimparTela Saida: Screen.MousePointer = vbDefault Set cnnComando = Nothing Exit Sub errGravacao: With Err If .Number <> 0 Then MsgBox "Houve um erro durante a gravação dos dados na tabela." & .Description, vbExclamation + vbOKOnly + vbApplicationModal, "Erro" 'MsgBox "Houve um erro durante a gravação dos dados na tabela.", vbExclamation + vbOKOnly + vbApplicationModal, "Erro" .Number = 0 GoTo Saida End If End With End Sub

Private Sub txtCodUsuario_LostFocus() Dim cnnComando As New ADODB.Command Dim rsSelecao As New ADODB.Recordset ' On Error GoTo errSelecao 'Verifica se foi digitado um código válido: If Val(txtCodUsuario.Text) = 0 Then MsgBox "Não foi digitado um código válido, verifique.", vbExclamation + vbOKOnly + vbApplicationModal, "Erro" Exit Sub End If Screen.MousePointer = vbHourglass With cnnComando 'abrir o banco para fazer a consulta e a inclusão: 'cnnbiblio.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};Dbq=D:\Projeto\Visual Basic\Bibliotecario\Biblio.mdb;" cnnbiblio.ConnectionString = "Provider=ADsDSOObject;Encrypt Password=False;Data Source=D:\Projeto\Visual Basic\Bibliotecario\Biblio.mdb;" cnnbiblio.Open .ActiveConnection = cnnbiblio .CommandType = adCmdText 'Monta o comando Select para selecionar o registro na tabela: .CommandText = "Select * from Usuarios where CodUsuario=" & txtCodUsuario.Text & ";" 'Set rsSelecao = .Execute End With With rsSelecao If .EOF And .BOF Then 'Se o recordset esta vazio, não retornou registro com esse código: LimparDados 'Identifica a operação como inclusão: vInclusao = True Else 'Senão, atribui aos campos os dados do registro: txtNomeUsuario.Text = !NomeUsuario txtEndereco.Text = !Endereco txtCidade.Text = !Cidade txtEstado.Text = !Estado txtCEP.Text = !CEP txtTelefone = Empty & !Telefone 'Identifica a operação como Alteração: vInclusao = True 'Habilita o botão Excluir: Toolbar1.Buttons(3).Enabled = True End If End With 'Desabilita a digitação do campo código: txtCodUsuario.Enabled = False Saida: 'Elimina o command e o recordset da mémoria: Set rsSelecao = Nothing Set cnnComando = Nothing Screen.MousePointer = vbDefault Exit Sub 'errSelecao: ' With Err ' If .Number <> 0 Then 'MsgBox "Houve um erro na recuperação do registro solicitado.", vbExclamation + vbOKOnly + vbApplicationModal, "Aviso" 'ver o erro ao digitar o código do usuário ' MsgBox "Houve um erro na recuperação do registro solicitado." & .Description, vbExclamation + vbOKOnly + vbApplicationModal, "Erro" ' .Number = 0 ' GoTo Saida ' End If 'End With End Sub Erro>:Run timer error'3704', quando debugo a linha If .EOF And .BOF Then esta amarela informando que o .BOF =<Operação não permitida quando o objeto está fechado.> Como resolver ?