Ronaldo73

Olá pessoal, tudo bem Fiz umas adaptações na minha planilha, e o botão atualizar não esta descarregando os dados do formulário para o Banco de dados, por isso postei o código abaixo para vocês verificar. Sub geral(nomeBD As String, ByVal IDFunc As Long, atualizar As Boolean, excluir As Boolean, novo As Boolean) Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & nomeBD & ";" Set rs = New ADODB.Recordset On Error Resume Next ' Separa o nome nos componentes "Título", "Primeiro nome" e "Sobrenome" ' A função Split somente funciona a partir do Excel XP nome = Split(frmBD.txtNome, " ") If atualizar = True And excluir = False And novo = False Then ' Inicia a construção da instrução SQL: ' Atualizar (UPDATE) Tabela e definir (SET) Cargo= frmBD.txtCargo ... Sql = "UPDATE " & Tabela & " SET Cargo='" & frmBD.txtCargo & "'" Sql = Sql & ", Título='" & nome(0) & "'" Sql = Sql & ", PrimeiroNome='" & nome(1) & "'" Sql = Sql & ", Sobrenome='" & nome(2) & "'" Sql = Sql & ", Admissão='" & frmBD.txtAdmissao & "'" Sql = Sql & ", Nascimento='" & frmBD.txtNascimento & "'" Sql = Sql & ", Ramal='" & frmBD.txtRamal & "'" Sql = Sql & ", FoneRes='" & frmBD.txtFone & "'" Sql = Sql & ", Notas='" & frmBD.txtNotas & "'" Sql = Sql & ", Notas2='" & frmBD.txtNotas2 & "'" ' Onde (WHERE) IDFunc= IDFunc Sql = Sql & " WHERE IDFunc=" & IDFunc ' Executar instrução cn.Execute Sql ' Se a condição acima não for verdadeira, então avaliar esta ' condição. Se esta condição for verdadeira, então, remover ' registro atual ElseIf atualizar = False And excluir = True And novo = False Then ' String SQL usada no método Execute da conexao Sql = "DELETE * FROM " & Tabela & " WHERE IDFunc=" & IDFunc ' Executar o comando SQL cn.Execute Sql ' Recarregar as informações do formulário Call carregarInfo ' Se a condição acima não for verdadeira, então avaliar esta ' condição. Se esta condição for verdadeira, então, adicionar ' registro. ElseIf atualizar = False And excluir = False And novo = True Then With rs .Open Tabela, cn, adOpenKeyset, adLockOptimistic, adCmdTable .AddNew .Fields("Sobrenome") = nome(2) .Fields("PrimeiroNome") = nome(1) .Fields("Título") = nome(0) .Fields("Cargo") = frmBD.txtCargo .Fields("Nascimento") = frmBD.txtNascimento .Fields("Admissão") = frmBD.txtAdmissao .Fields("FoneRes") = frmBD.txtFone .Fields("Ramal") = frmBD.txtRamal .Fields("Notas") = frmBD.txtNotas .Fields("Notas2") = frmBD.txtNotas2 .Update End With Call carregarInfo End If rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub

Estou tentando elaborar uma planilha personalizada para trabalhar com VB. Bom gente vou logo informar que esses código não foi eu minha autoria, foi pesquisando que encontrei. Eu só alterei algumas propriedade para poder gerar o meu projeto, mas tá difícil. minha dificudade esta sendo quando clico no botão de comando btnOk para salvar (ThisWorkbook.Worksheets("Entrada") Os dados do formulário estão indo para a planilha com data invertida po ex: o Correto seria assim 08/02/2010. mas gera 02/08/2010 na célua "b2" e também o valor de quantidades transportada esta indo com texto e o auto soma fica sempre zero (0). já tentei dois código, mas acho que eu não estou sabendo em qual das rotina colocar, por isso que coloquei os código abaixo. 1º Me. txtData.Value = Format (Plan2.Range("b2").Value, "dd/mm/aaaa") 2º Range("b2").Value = CDate (txtData.Text) 'Código: Tomás Vásquez 'http://www.tomasvasquez.com.br 'http://tomas.vasquez.blog.uol.com.br Option Explicit Const colRegistro As Integer = 1 Const colData As Integer = 2 Const colUsinagem As Integer = 3 Const colMaterialUsinado As Integer = 4 Const colTipoDeMaterial As Integer = 5 Const colAsfaltoUtilizado As Integer = 6 Const colTicket As Integer = 7 Const colQuantidade As Integer = 8 Const colAplicação As Integer = 9 Const colObservação As Integer = 10 Const indiceMinimo As Byte = 2 Const corDisabledTextBox As Long = -2147483633 Const corEnabledTextBox As Long = -2147483643 Private wsCadastro As Worksheet Private indiceRegistro As Long Private Sub btnCancelar_Click() btnOK.Enabled = False btnCancelar.Enabled = False Call DesabilitaControles Call CarregaDadosInicial Call HabilitaBotoesAlteracao End Sub Private Sub btnOK_Click() Dim proximoId As Long 'Altera If optAlterar.Value Then Call SalvaRegistro(CLng(txtReg.Text), indiceRegistro) lblMensagem.Caption = "Registro salvo com sucesso" End If 'Novo If optNovo.Value Then proximoId = PegaProximoId 'pega a próxima linha Dim proximoIndice As Long proximoIndice = wsCadastro.UsedRange.Rows.Count + 1 Call SalvaRegistro(proximoId, proximoIndice) txtReg = proximoId lblMensagem.Caption = "Registro salvo com sucesso" End If 'Excluir If optExcluir.Value Then Dim result As VbMsgBoxResult result = MsgBox("Deseja excluir o registro nº " & txtReg.Text & " ?", vbYesNo, "Confirmação") If result = vbYes Then wsCadastro.Range(wsCadastro.Cells(indiceRegistro, colRegistro), wsCadastro.Cells(indiceRegistro, colRegistro)).EntireRow.Delete Call CarregaDadosInicial lblMensagem.Caption = "Registro excluído com sucesso" End If End If Call HabilitaBotoesAlteracao Call DesabilitaControles End Sub Private Sub btnPesquisar_Click() frmPesquisa.Show End Sub Private Sub btnSair_Click() Unload Me End Sub Private Sub optAlterar_Click() If txtReg.Text <> vbNullString And txtReg.Text <> "" Then Call HabilitaControles Call DesabilitaBotoesAlteracao 'dá o foco ao primeiro controle de dados txtData.SetFocus Else lblMensagem.Caption = "Não há registro a ser alterado" End If End Sub Private Sub optExcluir_Click() If txtReg.Text <> vbNullString And txtReg.Text <> "" Then Call DesabilitaBotoesAlteracao lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo" Else lblMensagem.Caption = "Não há registro a ser excluído" End If End Sub Private Sub optNovo_Click() Call LimpaControles Call HabilitaControles Call DesabilitaBotoesAlteracao 'dá o foco ao primeiro controle de dados txtData.SetFocus End Sub Private Sub UserForm_Initialize() Set wsCadastro = ThisWorkbook.Worksheets("Entrada") Call HabilitaBotoesAlteracao Call CarregaDadosInicial Call DesabilitaControles End Sub Private Sub btnAnterior_Click() If indiceRegistro > indiceMinimo Then indiceRegistro = indiceRegistro - 1 End If If indiceRegistro > 1 Then Call CarregaRegistro End If End Sub Private Sub btnPrimeiro_Click() indiceRegistro = indiceMinimo If indiceRegistro > 1 Then Call CarregaRegistro End If End Sub Private Sub btnProximo_Click() If indiceRegistro < wsCadastro.UsedRange.Rows.Count Then indiceRegistro = indiceRegistro + 1 End If If indiceRegistro > 1 Then Call CarregaRegistro End If End Sub Private Sub btnUltimo_Click() indiceRegistro = wsCadastro.UsedRange.Rows.Count If indiceRegistro > 1 Then Call CarregaRegistro End If End Sub Private Sub CarregaDadosInicial() indiceRegistro = 2 Call CarregaRegistro End Sub Private Sub CarregaRegistro() 'carrega os dados do primeiro registro With wsCadastro If Not IsEmpty(.Cells(indiceRegistro, colTicket)) Then Me.txtReg.Text = .Cells(indiceRegistro, colRegistro).Value Me.txtData.Text = .Cells(indiceRegistro, colData).Value Me.cboUsina.Text = .Cells(indiceRegistro, colUsinagem).Value Me.cboMatUsinado.Text = .Cells(indiceRegistro, colMaterialUsinado).Value Me.cboTipoMaterial.Text = .Cells(indiceRegistro, colTipoDeMaterial).Value Me.cboAsfaltoUtilizado.Text = .Cells(indiceRegistro, colAsfaltoUtilizado).Value Me.txtTicket.Text = .Cells(indiceRegistro, colTicket).Value Me.txtQuantidade.Text = .Cells(indiceRegistro, colQuantidade).Value Me.cboAplicEquipe.Text = .Cells(indiceRegistro, colAplicação).Value Me.txtObs.Text = .Cells(indiceRegistro, colObservação).Value End If End With Call AtualizaRegistroCorrente End Sub Public Sub CarregaRegistroPorIndice(ByVal indice As Long) 'carrega os dados do registro baseado no índice indiceRegistro = indice Call CarregaRegistro End Sub Private Sub SalvaRegistro(ByVal id As Long, ByVal indice As Long) With wsCadastro .Cells(indice, colRegistro).Value = id .Cells(indice, colData).Value = Me.txtData.Text .Cells(indice, colUsinagem).Value = Me.cboUsina.Text .Cells(indice, colMaterialUsinado).Value = Me.cboMatUsinado.Text .Cells(indice, colTipoDeMaterial).Value = Me.cboTipoMaterial.Text .Cells(indice, colAsfaltoUtilizado).Value = Me.cboAsfaltoUtilizado.Text .Cells(indice, colTicket).Value = Me.txtTicket.Text .Cells(indice, colQuantidade).Value = Me.txtQuantidade.Text .Cells(indice, colAplicação).Value = Me.cboAplicEquipe.Text .Cells(indice, colObservação).Value = Me.txtObs.Text End With Call AtualizaRegistroCorrente End Sub Private Function PegaProximoId() As Long Dim rangeIds As Range 'pega o range que se refere a toda a coluna do código (id) Set rangeIds = wsCadastro.Range(wsCadastro.Cells(indiceMinimo, colRegistro), wsCadastro.Cells(wsCadastro.UsedRange.Rows.Count, colRegistro)) PegaProximoId = WorksheetFunction.Max(rangeIds) + 1 End Function Private Sub AtualizaRegistroCorrente() lblNavigator.Caption = indiceRegistro - 1 & " de " & wsCadastro.UsedRange.Rows.Count - 1 lblMensagem.Caption = "" End Sub Private Sub LimpaControles() Me.txtReg.Text = "" Me.txtData.Text = "" Me.cboUsina.Text = "" Me.cboMatUsinado.Text = "" Me.cboTipoMaterial.Text = "" Me.cboAsfaltoUtilizado.Text = "" Me.txtTicket.Text = "" Me.txtQuantidade.Text = "" Me.cboAplicEquipe.Text = "" Me.txtObs.Text = "" End Sub Private Sub HabilitaControles() 'Me.txtReg.Locked = False Me.txtData.Locked = False Me.cboUsina.Locked = False Me.cboMatUsinado.Locked = False Me.cboTipoMaterial.Locked = False Me.cboAsfaltoUtilizado.Locked = False Me.txtTicket.Locked = False Me.txtQuantidade.Locked = False Me.cboAplicEquipe.Locked = False Me.txtObs.Locked = False Me.txtData.BackColor = corEnabledTextBox Me.cboUsina.BackColor = corEnabledTextBox Me.cboMatUsinado.BackColor = corEnabledTextBox Me.cboTipoMaterial.BackColor = corEnabledTextBox Me.cboAsfaltoUtilizado.BackColor = corEnabledTextBox Me.txtTicket.BackColor = corEnabledTextBox Me.txtQuantidade.BackColor = corEnabledTextBox Me.cboAplicEquipe.BackColor = corEnabledTextBox Me.txtObs.BackColor = corEnabledTextBox End Sub Private Sub DesabilitaControles() 'Me.txtReg.Locked = True Me.txtData.Locked = True Me.cboUsina.Locked = True Me.cboMatUsinado.Locked = True Me.cboTipoMaterial.Locked = True Me.cboAsfaltoUtilizado.Locked = True Me.txtTicket.Locked = True Me.txtQuantidade.Locked = True Me.cboAplicEquipe.Locked = True Me.txtObs.Locked = True Me.txtData.BackColor = corDisabledTextBox Me.cboUsina.BackColor = corDisabledTextBox Me.cboMatUsinado.BackColor = corDisabledTextBox Me.cboTipoMaterial.BackColor = corDisabledTextBox Me.cboAsfaltoUtilizado.BackColor = corDisabledTextBox Me.txtTicket.BackColor = corDisabledTextBox Me.txtQuantidade.BackColor = corDisabledTextBox Me.cboAplicEquipe.BackColor = corDisabledTextBox Me.txtObs.BackColor = corDisabledTextBox End Sub Private Sub HabilitaBotoesAlteracao() 'habilita os botões de alteração optAlterar.Enabled = True optExcluir.Enabled = True optNovo.Enabled = True btnPesquisar.Enabled = True btnOK.Enabled = False btnCancelar.Enabled = False 'limpa os valores dos controles optAlterar.Value = False optExcluir.Value = False optNovo.Value = False End Sub Private Sub DesabilitaBotoesAlteracao() 'desabilita os botões de alteração optAlterar.Enabled = False optExcluir.Enabled = False optNovo.Enabled = False btnPesquisar.Enabled = False btnOK.Enabled = True btnCancelar.Enabled = True End Sub Public Function ProcuraIndiceRegistroPodId(ByVal id As Long) As Long Dim i As Long Dim retorno As Long Dim encontrado As Boolean i = indiceMinimo With wsCadastro Do While Not IsEmpty(.Cells(i, colRegistro)) If .Cells(i, colRegistro).Value = id Then retorno = i encontrado = True Exit Do End If i = i + 1 Loop End With 'caso não encontre o registro, retorna -1 If Not encontrado Then retorno = -1 End If ProcuraIndiceRegistroPodId = i End Function

Oi, Tudo bem? Tenho uma planilha no Ecxel muito simples, mas tenho um problema que eu não estou conseguindo descubrir através da apostila. Estou tentando atravéz de uma Caixa de Combinação para selecionar nomes e Um Objeto (Imagem de Bitmap) para fotos. Aparecer a foto quando eu seleciono um nome, mas ta difícil. Exemplo: Plan1/Cadastro de Funcionários - (Onde esta a Caixa de Combinação e o Objeto). Plan2/Dados - (Qtde/Nome/Setor/Cargo/Telefone/Idade/Código) Plan3/Fotos Estou tentando atribuir macro........... CaixaCombinação/AtribuirMacro/NomedaMacro(MudarFoto)/BotãoNovo. E é nesta parte que eu quero atribuir a macro que mudará a foto dentro do Objeto 8. Veja o código que usei dentro do editor do VBA, entre os códigos: Sub MudarFoto() ActiveSheet.Shapes("Objeto 8").Select Selection.Formula=Range("a19").Value Range("a3").Select End Sub bom vou explicar: "a19" aparece o código da foto na plan1 "a3" não consegui descubri na apostila que estou seguindo passo a passo na plan1. Quando eu executo a macro aparece um erro no código e vai para depurador (Selection.Formula=Range("a19").Value Alguém pode me ajudar Desde já agradeço Ronaldo

Obrigado Reyam. Abraço Obrigado José Abraço

Oi pessoal. Tudo Bem Estou aprendendo em casa visual basic 2005, tenho uma dúvida. tenho um formulário modelo com um GroupBox, neste a propriedade esta desativada e posso alterar. mas tenho dois formulário que o GroupBox esta travado com cadeado no canto esquerdo e quando eu seleciono a propriedade fica cinza sem opção nenhuma para eu desabilita-lo. Como fazer para habilitar as propriedades para eu poder aumentar o tamanho do GroupBox? Abraço Ronaldo

Oi, Estou com problema, alguém pode me ajudar. Olha eu tem um formulario Visual Basic com Excel Formulário eu tenho: Nº Nota Fiscal............................TxtNotaFiscal Despesas..................................CmbDespesas Data de Vencimento...................TxtVencimento Valor........................................TxtValor Só que, ao gravar o documento no excel o valor não soma e a data fica em ordem inversa. Por ex: Eu digito no formulário 14/02/09 e ao gravar na planilha do excel fica assim 02/14/09. Como corrigir este erro no código abaixo. ' A LINHA ABAIXO DETERMINA A PLAN3 (Despesas (-)) COMO SELECIONADA ActiveWorkbook.Sheets("Despesas (-)").Activate Range("c5").Select 'O CÓDIGO ABAIXO PROCURA A PRÓXIMA CÉLULA VAZIA Do If IsEmpty(ActiveCell) = False Then ActiveCell.Offset(1, 0).Select End If Loop Until IsEmpty(ActiveCell) = True ActiveCell.Value = TxtNotaFiscal.Value ActiveCell.Offset(0, 1).Value = CmbDespesas.Value ActiveCell.Offset(0, 3).Value = TxtVencimento.Value ActiveCell.Offset(0, 4).Value = TxtValor.Value If MsgBox("Confirma a operação?", vbYesNo + vbQuestion, "Confirmação") = vbYes Then End If

:rolleyes: Boa noite. estou procurando icon para colocar no meu projeto, mas não encontro seguindo a apostila VBA 5.0 no meu computador XP. Qual diretório estão estes icones? R.: também procurei na internet não encontrei! Ex: Msgbox04.ico Trffc14.ico Abraço Ronaldo

Boa tarde, Como faço para encontrar o diretório (Load Icon - Pasta Traffic)? Aguardo resposta Abraço

Macêdo muito obrigado pela dica, deu certo. Puxa estou me batendo no formulário. Como fazer para o botão buscar esta informação na planilha do excel já gravada e aparecer no formulário VBA? Desde já agradeço. Ronaldo

Oi pessoal, estou precisando de ajuda! Quero aprender fazer o mouse passar emcima de um botão (moradia), sem clicar e logo abaixo do botão aparecer todos as minhas despesas com moradia, tipo Telefone, Aluguel, Luz, àgua e etc.... Quais são as ferramentas que devo usar para este formulário e a codificação para funciona-los?

:blush: Bom dia João Neto. Coloquei o exemplo que você passou pra mim, só que não deu certo por um motivo, digitei no formulário a data 02/07/08 e gravou no excel 07/02/08, inverteu o dia e o mês! Antes o meu código estava assim: Range("A7").Select Veja o meu código abaixo com a substituição: Private Sub CBt_Gravar_Click() ' A LINHA ABAIXO DETERMINA A PLAN5 (Lançamento de Ticket) COMO SELECIONADA ActiveWorkbook.Sheets("Lançamento de Ticket").Activate Range("A7").Value = CDate(TBx_Data.Text) 'O CÓDIGO ABAIXO PROCURA A PRÓXIMA CÉLULA VAZIA Do If IsEmpty(ActiveCell) = False Then ActiveCell.Offset(1, 0).Select End If Loop Until IsEmpty(ActiveCell) = True ActiveCell.Value = TBx_Item.Value ActiveCell.Offset(0, 1).Value = TBx_Data.Value ActiveCell.Offset(0, 2).Value = TBx_Quantidade.Value ActiveCell.Offset(0, 7).Value = TBx_Codigo.Value ActiveCell.Offset(0, 4).Value = CBx_Usinagem.Value ActiveCell.Offset(0, 5).Value = CBx_Aplicacao.Value ActiveCell.Offset(0, 6).Value = TBx_Obs.Value 'O CÓDIGO ABAIXO LIMPA OS CAMPOS DO FORMULÁRIO E COLOCA O MARCADOR DO MOUSE NA CAIXA DE TEXTO NOME TBx_Item.Value = Empty TBx_Data.Value = Empty TBx_Quantidade.Value = Empty TBx_Codigo.Value = Empty CBx_Usinagem.Value = Empty CBx_Aplicacao.Value = Empty TBx_Obs.Value = Empty TBx_Item.SetFocus End Sub Private Sub CBt_Limpa_Click() TBx_Item.Text = "" TBx_Data.Text = "" TBx_Quantidade.Text = "" TBx_Codigo.Text = "" CBx_Usinagem.Text = "" CBx_Aplicacao.Text = "" TBx_Obs.Text = "" End Sub Private Sub CBt_Pesquisar_Click() Frm_Pesquisa.Show End Sub Private Sub TBx_Data_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) If Len(TBx_Data) = 0 Then TBx_Data.Text = "" End If If Len(TBx_Data) = 2 Then TBx_Data.Text = TBx_Data & "/" End If If Len(TBx_Data) = 5 Then TBx_Data.Text = TBx_Data & "/" End If End Sub E aproveitando o contado a quantidade lançada no formulário com vírgula também não soma valores? Mas quando eu digito ponto no formulário da quantidade é gravado no excel com virgula e o excel reconhece a fórmula, da pra entender. Obrigado pela dica anterior Se você puder me ajudar eu agradeço. Abraço Ronaldo

Galera........ Preciso da ajuda de vocês. Tenho um formulário com TextBox_Data. Porque quando eu gravo a data na planilha do excel através do formulário VBA a planilha do excel não aceita a fórmula do procv() #R/D e outras fórmulas?