Flecha

Kuroi, Entro no modo de alteração, set focus vai para o nome, passo para o RG e altero o RG para um que já exista na tabela dá o erro de duplicidade -2147467259, eu cerquei ele. Quando escolho na mensagem do erro OK para retornar a tela deveria voltar o campo RG com os dados que estavam antes de "tentar alterar que gerou o erro" ou seja não concretiza a alteração. Tipo não tem como cancelar o evento depois da mensagem de erro, voltando o registro da tela para como estava? Mesmo que eu mande limpar todas as box e voltar o comando gravar para editar, fica sem nada nos box ai vou para o próximo ou anterior ou ultimo ou primeiro registro pela navegação e vem o erro de duplicidade abortando o programa Debug ou End. Será que expliquei certo? Eu coloquei esse arquivo no 4shared para você. não sei se já estava com as alterações de controle de duplicidade no alterar e no incluir. http://www.4shared.com/file/nmh_n9xp/Cadastro_do_ZERO.html Flecha

Olá, Estou colocando validações no projeto e tratando os erros. meu primeiro teste foi evitar alteração do registro na entrada duplicada no meu caso é o RG. Coloquei o tratamento nessa sub: abaixo o Cara entra com o Nome novo e todos os dados se for o RG já existente quando clicar no Gravar gera o erro e interrompe dando a mensagem. Problema: Não muda os dados (conteudo do campo) após o tratamento, fica o Nº do RG na tela e o registro não passa para o seguinte e não volta ao dados Original (o anterior antes de ser alterado e gerado o erro) Private Sub CmdAltera_Click() On Error GoTo trataerro If CmdAltera.Caption = "&Altera" Then '------------------------ If MsgBox("Você tem certeza que quer alterar Nome '" _ & strNOME & " " & strRG & "'?", _ vbYesNo + vbQuestion, _ "Confirma Alteração") = vbNo Then Exit Sub End If '-------------------------- TxtNome.SetFocus CmdAltera.Caption = "&Grava" Exit Sub End If If CmdAltera.Caption = "&Grava" Then grava_rec Rs.Update CmdAltera.Caption = "&Altera" MsgBox "Alteração gravada ! ", , "Operação com Sucesso!!!" End If Exit Sub trataerro: If Err.Number = -2147467259 Then MsgBox "Erro número : " & Err.Number & " --> RG já Existe no Vivo !!! " & Chr(13) _ & "Favor verificar pelo RG e confirmar a duplicidade " & Chr(13) _ & " Caso exista use Alterar. NÃO PODE HAVER (RG) IGUAL" _ & Chr(13) & "NO MORTO ou NO VIVO " _ & Chr(13) & "Operação Cancelada", vbCritical, "Duplicidade de RG" 'Resume Next 'retorna a ação para a linha de código subsequente áquela que 'gerou o erro CmdAltera.Caption = "&Altera" clear_ctrls End If Exit Sub End Sub Quero repetir na Inclusão também e acho que vai acontecer a mesma coisa. Flecha :angry:

Kuroi, meu email flecha@limao.com.br Eu desinstalei o Crystal 11 Estou usando o 4.6 que pelo menos eu já estou um pouco familiarizado com ele. Tenho o também o 8.5 instalado Posso mandar um projeto para você verificar se está correto ? Tá funcionando e com relatório do 4.6. Só para comentário, que depois eu vou colocar uma opção para salvar o cara que vai sair do Departamento em outra tabela. Vou tentar colocar no 4shared. Não sei se por mp pode anexar arquivo. Consegui o arquivo esta aqui: http://www.4shared.com/file/nmh_n9xp/Cadastro_do_ZERO.html Aguardo Flecha

Kuroi, Resolvido, achei uma sub que é exatamente para isso, ela reconhece se é "string" "date" ou "numero" pela propriedade TAG da listview onde eu declaro o tamanho conforme abaixo Private Sub SetupCustLVCols() 'Largura Nome e Ordem das colunas do ListView '----------------------------------------------------------------------------- With lvwCustomer .ColumnHeaders.Clear .ColumnHeaders.Add(, , "Nome", .Width * 0.25).Tag = "string" .ColumnHeaders.Add(, , "RG", .Width * 0.11).Tag = "number" Depois com essa sub e a função abaixo resolve o problema Private Sub lvwCustomer_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) '------------------------------------------------------------------------- On Error Resume Next ' Começa ordenar o listview pela coluna clicada With lvwCustomer ' Display the hourglass cursor whilst sorting Dim lngCursor As Long lngCursor = .MousePointer .MousePointer = vbHourglass ' Prevent the ListView control from updating on screen - ' this is to hide the changes being made to the listitems ' and also to speed up the sort ' Check the data type of the column being sorted, ' and act accordingly Dim l As Long Dim strFormat As String Dim strData() As String Dim lngIndex As Long lngIndex = ColumnHeader.Index - 1 Select Case UCase$(ColumnHeader.Tag) Case "DATE" ' Sort by date. strFormat = "YYYYMMDDHhNnSs" ' Loop through the values in this column. Re-format ' the dates so as they can be sorted alphabetically, ' having already stored their visible values in the ' tag, along with the tag's original value With .ListItems If (lngIndex > 0) Then For l = 1 To .Count With .Item(l).ListSubItems(lngIndex) .Tag = .text & Chr$(0) & .Tag If IsDate(.text) Then .text = Format(CDate(.text), _ strFormat) Else .text = "" End If End With Next l Else For l = 1 To .Count With .Item(l) .Tag = .text & Chr$(0) & .Tag If IsDate(.text) Then .text = Format(CDate(.text), _ strFormat) Else .text = "" End If End With Next l End If End With ' Sort the list alphabetically by this column .SortOrder = (.SortOrder + 1) Mod 2 .SortKey = ColumnHeader.Index - 1 .Sorted = True ' Restore the previous values to the 'cells' in this ' column of the list from the tags, and also restore ' the tags to their original values With .ListItems If (lngIndex > 0) Then For l = 1 To .Count With .Item(l).ListSubItems(lngIndex) strData = Split(.Tag, Chr$(0)) .text = strData(0) .Tag = strData(1) End With Next l Else For l = 1 To .Count With .Item(l) strData = Split(.Tag, Chr$(0)) .text = strData(0) .Tag = strData(1) End With Next l End If End With Case "NUMBER" ' Sort Numerically strFormat = String(30, "0") & "." & String(30, "0") ' Loop through the values in this column. Re-format the values so as they ' can be sorted alphabetically, having already stored their visible ' values in the tag, along with the tag's original value With .ListItems If (lngIndex > 0) Then For l = 1 To .Count With .Item(l).ListSubItems(lngIndex) .Tag = .text & Chr$(0) & .Tag If IsNumeric(.text) Then If CDbl(.text) >= 0 Then .text = Format(CDbl(.text), _ strFormat) Else .text = "&" & InvNumber( _ Format(0 - CDbl(.text), _ strFormat)) End If Else .text = "" End If End With Next l Else For l = 1 To .Count With .Item(l) .Tag = .text & Chr$(0) & .Tag If IsNumeric(.text) Then If CDbl(.text) >= 0 Then .text = Format(CDbl(.text), _ strFormat) Else .text = "&" & InvNumber( _ Format(0 - CDbl(.text), _ strFormat)) End If Else .text = "" End If End With Next l End If End With ' Sort the list alphabetically by this column .SortOrder = (.SortOrder + 1) Mod 2 .SortKey = ColumnHeader.Index - 1 .Sorted = True ' Restore the previous values to the 'cells' in this ' column of the list from the tags, and also restore ' the tags to their original values With .ListItems If (lngIndex > 0) Then For l = 1 To .Count With .Item(l).ListSubItems(lngIndex) strData = Split(.Tag, Chr$(0)) .text = strData(0) .Tag = strData(1) End With Next l Else For l = 1 To .Count With .Item(l) strData = Split(.Tag, Chr$(0)) .text = strData(0) .Tag = strData(1) End With Next l End If End With Case Else ' Assume sort by string ' Sort alphabetically. This is the only sort provided ' by the MS ListView control (at this time), and as ' such we don't really need to do much here .SortOrder = (.SortOrder + 1) Mod 2 .SortKey = ColumnHeader.Index - 1 .Sorted = True End Select .MousePointer = lngCursor End With '****************************************************************** ESSA ERA A SUB ANTIGA PARA ORDENAR ' sort the listview on the column clicked ' ' With lvwCustomer ' If (.Sorted) And (ColumnHeader.SubItemIndex = .SortKey) Then ' If .SortOrder = lvwAscending Then ' .SortOrder = lvwDescending ' Else ' .SortOrder = lvwAscending ' End If ' Else ' .Sorted = True ' .SortKey = ColumnHeader.SubItemIndex ' .SortOrder = lvwAscending ' End If ' .Refresh ' End With ' If an item was selected prior to the sort, ' make sure it is still visible now that the sort is done. ' If Not lvwCustomer.SelectedItem Is Nothing Then ' lvwCustomer.SelectedItem.EnsureVisible ' End If End Sub '**************************************************************** ' InvNumber ' Function used to enable negative numbers to be sorted ' alphabetically by switching the characters '---------------------------------------------------------------- Private Function InvNumber(ByVal Number As String) As String Static i As Integer For i = 1 To Len(Number) Select Case Mid$(Number, i, 1) Case "-": Mid$(Number, i, 1) = " " Case "0": Mid$(Number, i, 1) = "9" Case "1": Mid$(Number, i, 1) = "8" Case "2": Mid$(Number, i, 1) = "7" Case "3": Mid$(Number, i, 1) = "6" Case "4": Mid$(Number, i, 1) = "5" Case "5": Mid$(Number, i, 1) = "4" Case "6": Mid$(Number, i, 1) = "3" Case "7": Mid$(Number, i, 1) = "2" Case "8": Mid$(Number, i, 1) = "1" Case "9": Mid$(Number, i, 1) = "0" End Select Next InvNumber = Number End Function Flecha

Kuroi, OA máquina tem essa dll. me diga uma coisa, quando inlui no projeto pela add e escolhe o crystal report 8.5 ele cria um form com o crview e um report design .dsr certo? Eu tenho sempre que abrir o relatorio pelo form que foi criado? Tipo no botão de imprimir fica frm.show. é só dessa forma? Flecha

Olá, Tenho a sub abaixo para ordenar a coluna do listview: Private Sub lvwCustomer_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader) '------------------------------------------------------------------------- ' sort the listview on the column clicked With lvwCustomer If (.Sorted) And (ColumnHeader.SubItemIndex = .SortKey) Then If .SortOrder = lvwAscending Then .SortOrder = lvwDescending Else .SortOrder = lvwAscending End If Else .Sorted = True .SortKey = ColumnHeader.SubItemIndex .SortOrder = lvwAscending End If .Refresh End With ' If an item was selected prior to the sort, ' make sure it is still visible now that the sort is done. If Not lvwCustomer.SelectedItem Is Nothing Then lvwCustomer.SelectedItem.EnsureVisible End If End Sub Nas colunas com campo texto sem problemas, mas quando quero ordenar uma coluna que o tipo é numerica não dá certo. fica assim: 1 10 100 101 109 11 111 112 .... ... 9 90 92 99 O que tem que alterar, para ordenar como texto? Flecha

Olá a todos, Meu nome é Norimar Moreira, sou funcionário público do Estado, SSPSP, tenho 54 anos e não sou programador. Na area que trabalho tem muito papel e ainda tem pessoas com mentalidade que não aceita a informática, mas isso está mudando. comecei com VBA lendo para ajudar no serviço mais rápido e assim foi começando e funcionava, tanto que outras pessoas pediam para fazer para eles também. Com o tempo o pessoal ia mexendo no programa "access" e melava tudo. Ai comecei a olhar os foruns pegar exemplo de VB e tentar criar um cadastro. Copia daqui cola ali, vai ao forum e tá saindo. Gostei mas é complicado, se não fosse vocês do forum já era. Agradeço a todos e peço a compreensão pela minha ignorância, vocês sabem de mais e jaudam muito mais. Parabéns a todos. E continuo aqui para perguntar e aprender. Flecha Norimar Moreira SP - SP

Kuroi, Eu tenho o 11 mas não é o developer será que vira ? Manda para mim para meu email a dll ou me dá o endereço para baixar. Flecha

Kuroi, Eu ainda estou com essa dificuldade, não alterei mais esse projeto devido esse problema e fiquei usando o cr 4.6 que já estou conseguindo para o que quero, mas gostaria de voltar o tópico pois quero usar o 8.5 que a interface é bem melhor de trabalhar. Então, O que precisa ter na máquina do usuário para rodar o cr 8.5 ? Tem que ficar aqueles form que ele cria para abrir o relatório dentro, ou seja para cada relatorio que ue criar tem que ter um form para abri-lo? Vou rodar novamente ele em uma máquina para ver os erros ou falhas e postar novamente. Flecha

Agora vou mudar tudo, com sua volta. Já não estou mais aprendendo nesse código acima, fiz um outro do zero e agora vou retornar a colocar as dúvidas aqui no forum. Obrigado Flecha

Kuroi, onde você estava? Ainda bem que voltou. Acho que é isso sim eu já havia colocado assim e funcionou; If Str$(Err.Number) = -2147467259 Then Flecha

Olá, Tenho uma sub abaixo para retirar o registro que esta no form na tabela "vivo" e arquivar na tabela "morto" e em seguida deletar da tabela " Vivo". O indice nas duas tabelas é o campo "RG" não aceita duplicação. Então quando for arquivar na tabela "morto" e existir o RG lá, vai dar o erro. Esta acontecendo o seguinte: Se não tem o RG no Morto esta efetuando o arquivo do registro do form na tabela morto e deletando da tabela Vivo. Normal. Se já existe o RG na tabela Morto a sub não completa a execução, até pergunta se tem certeza de quer arquivar no morto o fulano, e clicando em sim volta a tela do form com o cara lá, "não fez nada", não arquivou e não deu a mensagem que já tem ele no morto" O que está errado na minha sub? Não passa na MSGBOX para informar. Gostaria de colocar quando deu certo a mensagem "Registro arquivado com sucesso" Minha sub: Private Sub Arquivar_Click() Dim strNOME As String Dim strRG As String Dim lngCustID As Long Dim lngNewSelIndex As Long If lvwCustomer.SelectedItem Is Nothing Then MsgBox "Não tem Nome selecionado para Arquivar.", _ vbExclamation, _ "ARQUIVAR - MORTO" Exit Sub End If 'On Error GoTo erro_mdb 'inicia o tratamento de erros With lvwCustomer.SelectedItem strNOME = .text strRG = .SubItems(mlngCUST_RG_IDX) lngCustID = CLng(.SubItems(mlngCUST_ID_IDX)) End With If MsgBox("Você tem certeza que quer Arquivar Nome '" _ & strNOME & " " & strRG & "'?", _ vbYesNo + vbQuestion, _ "Confirma Exclusão") = vbNo Then Exit Sub End If On Error GoTo erro_mdb 'inicia o tratamento de erros mobjCmd.CommandText = "INSERT INTO Morto SELECT * FROM Customer WHERE CustID = " & lngCustID mobjCmd.Execute mobjCmd.CommandText = "DELETE FROM Customer WHERE CustID = " & lngCustID mobjCmd.Execute With lvwCustomer If .SelectedItem.Index = .ListItems.Count Then lngNewSelIndex = .ListItems.Count - 1 Else lngNewSelIndex = .SelectedItem.Index End If .ListItems.Remove .SelectedItem.Index If .ListItems.Count > 0 Then Set .SelectedItem = .ListItems(lngNewSelIndex) lvwCustomer_ItemClick .SelectedItem Else ClearCurrRecControls End If End With ' Informa o total de registros do bd Set mobjRst = New ADODB.Recordset mobjRst.CursorLocation = adUseClient mobjRst.Open "Select * From Customer", mobjConn, adOpenKeyset, adLockOptimistic, adCmdText Label25.Caption = "Total de Registros = " & mobjRst.RecordCount '------------- erro_mdb: If Error = "0" Then Resume Next '"2147467259" Then If Error = "2147467259" Then MsgBox "Erro número : " & Str$(Err.Number) & " --> RG já Existe no Morto !!! " & Chr(13) _ & "Favor verificar no Morto pelo RG e confirmar a duplicidade " & Chr(13) _ & " se é o mesmo do que esta no Vivo. NÃO PODE HAVER (RG) IGUAL" _ & Chr(13) & "DO MORTO NO VIVO e Vice-Versa " _ & Chr(13) & "Operação Cancelada" 'Resume Next 'retorna a ação para a linha de código subsequente áquela que 'gerou o erro End If End Sub

Qintelab No comando para procurar abaixo: Private Sub Command4_Click() Dim Procurar As String Procurar = InputBox("Coloque o nome que deseja procurar", , "Aviso") Set RsTabela = Db.OpenRecordSet("SELECT * FROM Tabela WHERE Nome='" & Procurar & "'", DbOpenDyNaset) If RsTabela.RecordCount = 0 Then MsgBox "Registro não encontrado", 64, "Aviso" Else TxtCodigo.Text = RsTabela("Codigo") TxtNome.Text = RsTabela("Nome") TxtObs.Text = RsTabela("Obs") End If End Sub Dá erro na linha do Set RsTabela erro 424 Objeto requerido Flecha

Olá, Consegui usar o report 8.5 no meu projeto na máquina de casa. Levei o projeto para outra máquina e instalei. Quando vai imprimir acusou que o BD não estava no caminho indicado do CrystalReport1, acusava que não localizava na pendrive. Tive que abrir setar novamente o BD Ele não carrega o caminho de onde está instalado o exe, o rpt e o que mais precisa o projeto? depois de corrigido isso quando vai imprimir ela "parece que vai abrir o relatório" mas não abre, parece um FLASH muito rápido e não dá erro. e toda vez que faz isso salva um arquivo .tmp no diretório raiz, alguns vazios e outros com alguns bites, mas não abre com nada para ver o que tem dentro se abrir como txt tá chei de tranqueira não legível. Salva com nomes tipo ¨7f, 8DF, VB18, etc... De toda forma tive que instalar o Crystal 8.5 na outra máquina também. Algém sabe o que pode ser? Minha sub para imprimir é essa: Private Sub SSCommand1_Click(Index As Integer) Select Case Index Case 0 If Option1(0).Value = True Then With cr1 .WindowState = 2 .DataFiles(0) = GetAppPath() & "Cust.MDB" .ReportFileName = GetAppPath() & "Report1.rpt" ***** Esse report aqui é do Crystal 8.5, acontece o problema .SelectionFormula = "" .PrintReport '.Action = 1 .Destination = crptToWindow End With End If If Option1(4).Value = True Then 'Essa opção aqui é com o report feito pelo 4.6 e é normal With cr1 .WindowState = 2 .DataFiles(0) = GetAppPath() & "Cust.MDB" .ReportFileName = GetAppPath() & "Report2.rpt" .SelectionFormula = "" .PrintReport ' .Action = 1 .Destination = crptToWindow End With End If If Option1(5).Value = True Then ' Dim strCargo As String Dim strValor As String strCargo = Combo1Rel.text strValor = Combo2Rel.text With cr1 .WindowState = 2 .DataFiles(0) = GetAppPath() & "Cust.MDB" .ReportFileName = GetAppPath() & "Report1.rpt" ***** Esse tamém eé do Crystal 8.5 usando a fórmula e tb dá o problema .SelectionFormula = "{ado." & strCargo & "} = '" & strValor & "'" .PrintReport .Destination = crptToWindow '.Action = 1 End With End If Case 1 Unload Me End Select End Sub Alguém sabe resolver ? O que tenho que alterar se for preciso? Flecha

Olá, Preciso colocar nesse projeto abaixo as subs para Incluir, Excluir, Salvar, Localizar e Alterar, não sei fazer tem como alguém criar para mim , eu já criei os botões mas andei pegando exemplo por ai e não deu certo. Com isso, acho que é o básico de um projeto e eu vou aprender e assim ir melhorando nas validações. Até coloquei uma de Procurar mas não dá erro e não procura nada. Public Conexao As ADODB.Connection Private RsTabela As ADODB.Recordset Private Cmd As ADODB.Command Private Sub Atualizar() TxtCodigo.Text = RsTabela("codigo") TxtNome.Text = RsTabela("nome") TxtObs.Text = RsTabela("obs") End Sub Private Sub CmdAnterior_Click() Set Cmd = New ADODB.Command Set Cmd.ActiveConnection = Conexao Cmd.CommandType = adCmdText Cmd.CommandText = "select * from tabela where codigo=(select max(codigo) from tabela where codigo < ?)" Cmd.Parameters(0).Value = TxtCodigo.Text Set RsTabela = Cmd.Execute If Not RsTabela.EOF Then Atualizar End If RsTabela.Close Set RsTabela = Nothing Set Cmd = Nothing End Sub Private Sub CmdPrimeiro_Click() Set RsTabela = New ADODB.Recordset RsTabela.Open "Select * From Tabela where codigo=(select min(codigo) from tabela)", Conexao, adOpenDynamic If Not RsTabela.EOF Then Atualizar End If RsTabela.Close Set RsTabela = Nothing End Sub Private Sub CmdProximo_Click() Set Cmd = New ADODB.Command Set Cmd.ActiveConnection = Conexao Cmd.CommandType = adCmdText Cmd.CommandText = "select * from tabela where codigo=(select min(codigo) from tabela where codigo > ?)" Cmd.Parameters(0).Value = TxtCodigo.Text Set RsTabela = Cmd.Execute If Not RsTabela.EOF Then Atualizar End If RsTabela.Close Set RsTabela = Nothing Set Cmd = Nothing End Sub Private Sub CmdUltimo_Click() Set RsTabela = New ADODB.Recordset RsTabela.ActiveConnection = Conexao RsTabela.CursorLocation = adUseClient RsTabela.CursorType = adOpenDynamic RsTabela.Open "Select * From Tabela where codigo=(select max(codigo) from tabela)" If Not RsTabela.EOF Then Atualizar End If RsTabela.Close Set RsTabela = Nothing End Sub _______________________________________________________________________ Private Sub Command1_Click() End End Sub Private Sub Command2_Click() MsgBox "Não foi desenvolvido ainda!!!!", vbExclamation, _ "Aviso" End Sub Private Sub Command4_Click() Dim Procurar As String Procurar = InputBox("Coloque o nome que deseja procurar", , "Aviso") Set RsTabela = Db.OpenRecordSet("SELECT * FROM Tabela WHERE Nome='" & Procurar & "'", DbOpenDyNaset) If RsTabela.RecordCount = 0 Then MsgBox "Registro não encontrado", 64, "Aviso" Else TxtCodigo.Text = RsTabela("Codigo") TxtNome.Text = RsTabela("Nome") TxtObs.Text = RsTabela("Obs") End If End Sub Private Sub Form_Load() 'abre banco Set Conexao = New ADODB.Connection Conexao.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source= " & App.Path & "\banco.mdb" 'Frame1.Enabled = False CmdPrimeiro_Click End Sub Private Sub UltimoCmd_Click() Set RsTabela = New ADODB.Recordset RsTabela.ActiveConnection = Conexao RsTabela.CursorLocation = adUseClient RsTabela.CursorType = adOpenDynamic RsTabela.Open "Select * From Tabela where codigo=(select max(codigo) from tabela)" If Not RsTabela.EOF Then Atualizar End If RsTabela.Close Set RsTabela = Nothing End Sub Flecha

Olá, Tenho o Crystal 11 Profissional e o Cristal 2008 que acho que é o 12 Quero usar com o vb6, dá para usar? são as versões corretas? Já vi por ai que tem que ser o Crystal developer, é verdade? O que precisa carregar para o projeto? Está dificil de achar alguma coisa explicando o que carregar e como chamá-lo no código para imprimir. Não estou achando para baixar o Crystal 8 ou 8.5 que me parece que a maioria usa, algum lugar seguro para baixa-lo ou alguém pode disponibilizar? Flecha

Olá Raphael, Cadê o Kuroi? Quanto a sua proposta coloquei assim como sub Private Function ver_dupli() 'Verifica se o Registro existe no Morto caso exista não executa o Arquivo, pois dará Duplicidade Dim IDsEncontrados As Recordset Dim strsql As String If Not IsNull(Me.txtRg) Then strsql = " SELECT custid FROM tabela2 WHERE txtid = " & Me.TxtID & "" Set IDsEncontrados = mobjConn.OpenRecordset(strsql) End If If IDsEncontrados.RecordCount <> 0 Then ' Encontrou RG no Morto MsgBox "Esse Registro já existe no morto, vou abrir a ficha do Morto!!" & Chr(13) & "E nela você deverá excluir o registro desse RG" & Chr(13) & " e depois repetir a operação de Arquivar no Morto, OK ?", vbInformation, "Aviso já existe no Morto" Morto.Show ' DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg") Exit Function Else MsgBox "Pode arquivar no morto que não tem duplicidade", vbInformation, " Aviso" End If End Function Está retornando erro na linha abaixo (eu troquei por morto.show só para testar a função,) preciso trocar a linha abaixo DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg") como passo ela para vb6 a linha acima? Tem que fazer isso: tem que abrir (show)o form "morto" com os dados da tabela2 onde o custID (atual) é igual ao custID da tabela2 localizada (duplicidade) Esta dando erro 3001 Os argumentos são incorretos, estão fora do intervalo aceitavel ou estão em conflito. nessa linha ----> Set IDsEncontrados = mobjConn.OpenRecordset(strsql) Como saio dessa? Flecha

Olá, Achei essa dica e funcionou, agora para editar o programa é só rolar o mouse e as linhas do projeto correm paracima e para baixo. Baixe o exemplo e a dll no link abaixo, nele também está a explicação de como proceder. http://support.microsoft.com/?id=837910 Flecha

Pessoal, Alterei o nome do MDB e também o nome da tabela. Alterei tudo no projeto, até as chamadas das fórmulas dos relatórios. Agora não consigo mudar no report manager o nome do MDB e a tabela usada. Tenho que refazer os relatórios do ZERO ? Todos os campos são os mesmos, só resolvi trocar os nomes, pois não tinham nada com o assunto. Flecha

Olá, Tenho a sub abaixo no access para testar se uma tabela já tem um registro que quero incluir. 'Verifica se o Registro existe no Morto caso exista não executa o Arquivo, pois dará Duplicidade Dim IDsEncontrados As Recordset If Not IsNull(Me.RG) Then strSQL = " SELECT rg FROM tabela2 WHERE rg = " & Me.RG & "" Set IDsEncontrados = CurrentDb.OpenRecordset(strSQL) End If If IDsEncontrados.RecordCount <> 0 Then ' Encontrou RG no Morto MsgBox "Esse Registro já existe no morto, vou abrir a ficha do Morto!!" & Chr(13) & "E nela você deverá excluir o registro desse RG" & Chr(13) & " e depois repetir a operação de Arquivar no Morto, OK ?", vbInformation, "Aviso já existe no Morto" DoCmd.OpenForm "morto", acNormal, , "rg = " & IDsEncontrados("rg") Exit Sub Else MsgBox "Pode arquivar no morto que não tem duplicidade", vbInformation, " Aviso" 'End If End If Tenho a sub abaixo em um projeto VB6 para incluir o registro em outra tabela (ela não verifica se já existe na outra) se tiver dá erro. Private Sub Arquivar_Click() Dim strNOME As String Dim strRG As String Dim lngCustID As Long Dim lngNewSelIndex As Long If lvwCustomer.SelectedItem Is Nothing Then MsgBox "Não tem Nome selecionado para Arquivar.", _ vbExclamation, _ "ARQUIVAR - MORTO" Exit Sub End If With lvwCustomer.SelectedItem strNOME = .text strRG = .SubItems(mlngCUST_RG_IDX) lngCustID = CLng(.SubItems(mlngCUST_ID_IDX)) End With If MsgBox("Você tem certeza que quer Arquivar Nome '" _ & strNOME & " " & strRG & "'?", _ vbYesNo + vbQuestion, _ "Confirma Exclusão") = vbNo Then Exit Sub End If mobjCmd.CommandText = "INSERT INTO Morto SELECT * FROM Customer WHERE CustID = " & lngCustID mobjCmd.Execute mobjCmd.CommandText = "DELETE FROM Customer WHERE CustID = " & lngCustID mobjCmd.Execute With lvwCustomer If .SelectedItem.Index = .ListItems.Count Then lngNewSelIndex = .ListItems.Count - 1 Else lngNewSelIndex = .SelectedItem.Index End If .ListItems.Remove .SelectedItem.Index If .ListItems.Count > 0 Then Set .SelectedItem = .ListItems(lngNewSelIndex) lvwCustomer_ItemClick .SelectedItem Else ClearCurrRecControls End If End With ' Informa o total de registros do bd Set mobjRst = New ADODB.Recordset mobjRst.CursorLocation = adUseClient mobjRst.Open "Select * From Customer", mobjConn, adOpenKeyset, adLockOptimistic, adCmdText Label25.Caption = "Total de Registros = " & mobjRst.RecordCount End Sub Na General declarations esta assim Option Explicit Private mobjConn As ADODB.Connection Private mobjCmd As ADODB.Command Private mobjRst As ADODB.Recordset Como faço para incluir a sub do access no inicio da sub arquivar para fazer a verificação antes de prosseguir com a inclusão e não dar o erro? Os comandos da sub do access tem que ser modificados? qual os comando que tem que ser trocados para o vb reconhecer? Obrigado Flecha

MrMalj O bat funciona sim, registra e pode fazer outro para unregister. Flecha

Entendi, Já fiz um teste e o setup cru a pasta dos reltorios e colocou os mesmos dentro, ms deu um problema na hora de executar o programa, acho que tem que mudar a linha do report no projeto, a minha est assim If Option1(0).Value = True Then With cr1 .WindowState = 2 .DataFiles(0) = GetAppPath() & "Cust.MDB" .ReportFileName = GetAppPath() & "Report1.rpt" .SelectionFormula = "" .Action = 1 End With Na linha .ReporFileNam = GetAppPath ()/Relatorios & "Report1.rpt" É assim que tem que ficar para paa achar? Corrija para mim se estiver errado, por favor. Flecha

Kuroi, Você lembra que eu estava tentando usar a proteção com o nslock15vb5.ocx ? Eu consegui, ai dentro do general de um projto você coloca um código que é gerado por esse programinha, o códgo gerado é nsse fomato: Option Explicit Const GUI = "4BE96C57-F3BF-11D6-A57D-B2A419659821" Dim cmd As Integer Depois quando vence o prazo do projeto Trial o cliente entra em um form que passa uma senha que foi gerada com base nesse GUI que o projeto carrega com ele. (para cada projeto (cópia) você gera um novo GUI). GUID - Gerando um identificador Único . Com essa senha passada para o desenvolvedor ele usa um Keygen e gera uma contra senha para registrar o programa. Esse projetinho paa gerar esse código cada vez que se clicano botão el vai colocando um sequencia no listbox, só que não dava para copiar com ctrl c e colar no projeto com ctrl v, ai eu criei um txtbox no form e mandei gerar dentro dele e deu para copiar. Entendeu ? Já resolvi é coisa dosite do macoratti nesse link: http://www.macoratti.net/d130402.htm Abraço Flecha

Pessoal, Peguei um programinha para criar aquele código universal GUI No form tem um botão e um listbox Quando clica o botão ele gera um código no listbox, acontece que não dá para cpoiar e colar no projeto tenho que anotar os 16 dígito para colocá-los no projeto. Tem alguma propriedade para habilitar para permitir colar copiar? Flecha

Kuroi, Então fica assim: [setup1 Files] File1=@report2.rpt,c:\Cadastro\Report,,,2/6/10 1:48:34 PM,7141,0.0.0.0 File2=@report1.rpt,c:\Cadastro\Report,,,2/6/10 1:45:56 PM,5651,0.0.0.0 File3=@Ficha.doc,c:\Cadastro\Doc,,, 11:22:30 AM,392704,0.0.0.0 File4=@Ferias.doc,c:\Cadastro\Doc,,,2/14/10 11:25:48 AM,29696,0.0.0.0 Quanto ao exe, sim ele fica no apppath, eu quero que o setup crie e instale os outros objetos em suas pastas Diz outra coisa, eu estou apanhando com icon e bmp Eu coloco uma figura bmp em um label, forneço o caminho para achar a figura e salvo o projeto Essas figuras precisam seguir com o package, ou seja tenho que colocar uma cópia das figuras e icons que usei no "cliente" ou elas ficam armazenadas no projeto. Obrigado Flecha