Jump to content
Sign in to follow this  
DinhoPHP

Inserção duplicada

Recommended Posts

Bom dia!

 

Estou utilizando esta programação para cadastrar nomes de PCs e partir desta lista checar se o nome da máquina consta nela para exibir uma planilha e esconder a mesma, só que está havendo um cadastramento duplicados e não sei porque. Isso não pode ocorrer.

 

Obs: Não programo macros, e sim para web como: JAVA, PHP, HTML5 e etc.i

Share this post


Link to post
Share on other sites
Private Sub btnok_Click()

'verifica se tudo foi preenchido

If Me.txtnome = "" Then

MsgBox "Insira o nome computador", vbExclamation, "Erro!"

Exit Sub

Me.txtnome.SetFocus

'ElseIf Me.txtcargo = "" Then

'MsgBox "Insira cargo / setor!", vbExclamation, "Erro!"

'Exit Sub

'Me.txtcargo.SetFocus

'ElseIf Len(Me.txtdata) < Me.txtdata.MaxLength Then

'MsgBox "Insira data no formato dd/mm/aaaa!", _

' vbExclamation, "Erro!"

'Exit Sub

'Me.txtdata.SetFocus

End If


'solicita autorização

If MsgBox("Deseja inserir estes dados?", vbOKCancel + vbQuestion, _

"Atenção!") = vbCancel Then Exit Sub


'desabilita atualização de tela

Application.ScreenUpdating = False


'LANÇA NA ABA GERAL


'desprotege a planilha

ActiveSheet.Unprotect

'exibe todas as linhas

ActiveSheet.Rows.Hidden = False

'define última linha da lista

Dim lin As Integer

lin = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'lança o nome na última linha

Cells(lin, 1) = Me.txtnome

Cells(lin, 1).HorizontalAlignment = xlLeft

'Cells(lin, 2) = Me.txtcargo

'Cells(lin, 2).HorizontalAlignment = xlLeft

'Cells(lin, 3) = Format(Me.txtdata, "mm/dd/yyyy")

'Cells(lin, 3).HorizontalAlignment = xlCenter

'desenha bordas na linha preenchida

Range(Cells(lin, 1), _

Cells(lin, 1)).Borders.LineStyle = xlContinuous

'organiza em ordem crescente (pela coluna A)

With ActiveSheet

.Sort.SortFields.Clear

.Sort.SortFields.Add Key:=Range("A3"), _

SortOn:=xlSortOnValues, Order:=xlAscending, _

DataOption:=xlSortNormal

End With

With ActiveSheet.Sort

.SetRange Range("A3:C" & lin)

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

'oculta linhas vazias

Range(Cells(lin + 1, 1), Cells(Rows.Count, 1)).EntireRow.Hidden = True

Range("A1").Select

'protege a planilha

ActiveSheet.Protect


'LANÇA NA ABA ESPECÍFICA


'Sheets(Format(Month(Me.txtdata), "00")).Select

'desprotege a planilha

ActiveSheet.Unprotect

'exibe todas as linhas

ActiveSheet.Rows.Hidden = False

'define última linha da lista

Dim lin2 As Integer

lin2 = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'lança o nome na última linha

Cells(lin2, 1) = Me.txtnome

Cells(lin2, 1).HorizontalAlignment = xlLeft

'Cells(lin2, 2) = Me.txtcargo

'Cells(lin2, 2).HorizontalAlignment = xlLeft

'Cells(lin2, 3) = Format(Day(Me.txtdata), "00")

'Cells(lin2, 3).HorizontalAlignment = xlCenter

'desenha bordas na linha preenchida

Range(Cells(lin2, 1), _

Cells(lin2, 3)).Borders.LineStyle = xlContinuous

'organiza em ordem crescente (pela coluna A)

With ActiveSheet

.Sort.SortFields.Clear

.Sort.SortFields.Add Key:=Range("C3"), _

SortOn:=xlSortOnValues, Order:=xlAscending, _

DataOption:=xlSortNormal

End With

With ActiveSheet.Sort

.SetRange Range("A3:C" & lin2)

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

'oculta linhas vazias

Range(Cells(lin2 + 1, 1), Cells(Rows.Count, 1)).EntireRow.Hidden = True

Range("A1").Select

'protege a planilha

ActiveSheet.Protect


'VOLTA NA ABA GERAL

Sheets("geral").Select


'habilita atualização de tela

Application.ScreenUpdating = True


'limpa o formulário

Me.txtnome = ""

'Me.txtcargo = ""

'Me.txtdata = ""

Me.txtnome.SetFocus


End Sub


Private Sub btnlimpar_Click()

Me.txtnome = ""

'Me.txtcargo = ""

'Me.txtdata = ""

Me.txtnome.SetFocus

End Sub


Private Sub btnsair_Click()

Unload Me

End Sub


Private Sub Label1_Click()


End Sub


Private Sub txtnome_Change()

Me.txtnome.MaxLength = 50

Me.txtnome = UCase(Me.txtnome)

End Sub


Private Sub txtcargo_Change()

'Me.txtcargo.MaxLength = 30

'Me.txtcargo = UCase(Me.txtcargo)

End Sub


Private Sub txtdata_Change()

'txtdata.MaxLength = 10

Select Case KeyAscii

Case 8, 48 To 57 ' backspace e numéricos

Case Else ' o resto é travado

KeyAscii = 0

End Select


If KeyAscii = vbKeyReturn Or KeyAscii = vbKeyBack Then Exit Sub


If KeyAscii < vbKey0 Or KeyAscii > vbKey9 Then

KeyAscii = 0

End If


'If Len(txtdata) = 2 Then

' txtdata.Text = txtdata.Text & "/"

' SendKeys "{End}", False

'ElseIf Len(txtdata) = 5 Then

' txtdata.Text = txtdata.Text & "/"

' SendKeys "{End}", False

'End If


End Sub

Share this post


Link to post
Share on other sites

por Reinaldo » Seg Jan 04, 2016 11:27 am

O trecho 'LANÇA NA ABA GERAL e 'LANÇA NA ABA ESPECÍFICA não se movimentam entre as abas do arquivo, lançam dados SEMPRE na aba ativa (activesheet).
Aparentemente o arquivo está posicionado na Aba Geral no inicio do "Lançamento de Dados", como a linha :
'Sheets(Format(Month(Me.txtdata), "00")).Select foi comentada/inibida, os dados à partir dessa linha são inseridos na mesma aba; é preciso determinar/selecionar a aba especifica, ou elininar essas linhas da rotina

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

  • Similar Content

    • By kendy1290
      Olá! Estou com problema referente a exportação de gráficos do Excel via VBA para apresentação do PowerPoint. A maneira que encontrei, inclusive em várias fontes é de exportar vários gráficos de uma vez ou uma ,em uma nova apresentação. O que estou precisando é de exportar os gráficos do Excel em um arquivo do PowerPoint existente, em slides e locais específicos das apresentações. Se alguém tiver alguma  ideia de como fazer seria de muita ajuda. 
    • By Delcio Costa
      Olá!, sou novato no php e gostaria de entender como posso separar valores por data, preciso fazer um SELECT para poder realizar o calculo depois, mas para isso acredito que preciso separar os valores da seguinte forma:
      Separar o ultimo registro do VALOR no dia ATUAL  e diminuir do ultimo registro do VALOR no dia ANTERIOR
      Seria algo tipo isso:
      ultimo registro do dia anterior foi: VALOR = 40 , DATA 03-12-2019, HORA 19:30:00
      ultimo registro do dia atual foi    :  VALOR = 60 , DATA 04-12-2019, HORA 17:00:00  
      $ultimo_valor_dia_atual - $ultimo_valor_dia_anterior = valor_acumulado = 20
      Não faço a minima ideia de como fazer isso, já procurei por tudo e não consigo nem achar um exemplo próximo disso, sempre aparece somente como manipular data, mas preciso manipular o valor conforme a data.
      Alguém poderia me ajudar.
    • By sapinhox
      Tenho um programa desenvolvido em VBA para Autocad, o mesmo tem duas linhas de programação que estão dando o seguinte erro:
       
       
      as linhas que estão dando erro são as seguintes
       
      Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
      Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
       
      Acredito que tenha alguma coisa a ver do fato do sistema instalado ser 64 bits, algum tem alguma solução para o caso.
       
      Desde já agradeço
       

    • By cesarhtc
      Boa tarde não estou conseguindo rodar o codigo abaixo:

       
      Const IntervaloSegundos = 5 * 60 ' 5 minutos de intervalo Sub Iniciar() Alarme = Now + TimeSerial(0, 0, IntervaloSegundos) Application.OnTime EarliestTime:=Alarme, procedure:="Macro_Atualizar_Tramite_web", schedule:=True End Sub Function Macro_Atualizar_Tramite_web() On Error GoTo Macro_Atualizar_Tramite_web_Err DoCmd.SetWarnings False DoCmd.OpenQuery "CRIAR_TABELA_TRAMITACAO_CONTRATACAO", acViewNormal, acEdit DoCmd.OpenQuery "CRIAR_TABELA_TRAMITACAO_CONSUMO", acViewNormal, acEdit Beep MsgBox "Dados Atualizados!", vbExclamation, "Carga" Macro_Atualizar_Tramite_web_Exit: Exit Function Macro_Atualizar_Tramite_web_Err: MsgBox Error$ Resume Macro_Atualizar_Tramite_web_Exit Call Iniciar End Function Sub Parar() On Error Resume Next Application.OnTime EarliestTime:=Alarme, procedure:="Macro_Atualizar_Tramite_web", schedule:=False End Sub Obrigado
    • By Fabio de Souza
      Ola amigos é minha primeira vez no forum,
       
      Estou com o seguinte problema:
       
      efetuei uma planilha em vba excel, porem em uma determinada textbox, estou tendo dor de cabeça,
      fiz uma tabela que busca de valores e insere de valores.
       
      Na tabela fde inserção de valores, tudo, ok
      efetuei a formula com comando Cdate(textde) - quando preenche a mesma ela inserre corretamente em formato de datas porem,
      na  busca de valores quando a celula na estão preenchida ele nãos tras nada nesta txtDE, e quando eu efetuo a alteração ele da erro,
      porque na opção "Cdade" tem que esdta preenchida com alguma coisa...
       
       
      consegume me ajudar?
      ' este faz a busca de valores:
       
      Private Sub txtLocaliza_AfterUpdate()
      Dim intervalo As Range
      Dim texto As String
      Dim codigo As Integer
      Dim pequisa
      Dim mensagem
          codigo = txtLocaliza.Value
      'Sheets("Clientes").Select
      Set intervalo = Sheets("Clientes").Range("A:Y")
      On Error GoTo trataErro
      pesquisa = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, False)
      pesq1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 3, False)
      pesq2 = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, False)
      pesq3 = Application.WorksheetFunction.VLookup(codigo, intervalo, 5, False)
      pesq4 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, False)
      pesq5 = Application.WorksheetFunction.VLookup(codigo, intervalo, 7, False)
      pesq6 = Application.WorksheetFunction.VLookup(codigo, intervalo, 8, False)
      pesq7 = Application.WorksheetFunction.VLookup(codigo, intervalo, 9, False)
      pesq8 = Application.WorksheetFunction.VLookup(codigo, intervalo, 10, False)
      pesq9 = Application.WorksheetFunction.VLookup(codigo, intervalo, 11, False)
      pesq10 = Application.WorksheetFunction.VLookup(codigo, intervalo, 12, False)
      pesq11 = Application.WorksheetFunction.VLookup(codigo, intervalo, 13, False)
      pesq12 = Application.WorksheetFunction.VLookup(codigo, intervalo, 14, False)
      pesq13 = Application.WorksheetFunction.VLookup(codigo, intervalo, 15, False)
      pesq14 = Application.WorksheetFunction.VLookup(codigo, intervalo, 16, False)
      pesq15 = Application.WorksheetFunction.VLookup(codigo, intervalo, 17, False)
      pesq16 = Application.WorksheetFunction.VLookup(codigo, intervalo, 18, False)
      pesq17 = Application.WorksheetFunction.VLookup(codigo, intervalo, 19, False)
      pesq18 = Application.WorksheetFunction.VLookup(codigo, intervalo, 20, False)
      pesq19 = Application.WorksheetFunction.VLookup(codigo, intervalo, 21, False)
      pesq20 = Application.WorksheetFunction.VLookup(codigo, intervalo, 22, False)
      pesq21 = Application.WorksheetFunction.VLookup(codigo, intervalo, 23, False)
      pesq22 = Application.WorksheetFunction.VLookup(codigo, intervalo, 24, False)
      pesq23 = Application.WorksheetFunction.VLookup(codigo, intervalo, 25, False)
      pesq24 = Application.WorksheetFunction.VLookup(codigo, intervalo, 1, False)
      lblCod = pesq24
      txtAddress = CDate(pesquisa)
      txtNumber = pesq1
      txtNeighb = pesq2
      txtCity = pesq3
      cbUF = pesq4
      txtDDD1 = Format(CCur(pesq5), "#0.000")
      txtPhone1 = Format(CCur(pesq6), "#0.000")
      txtDDD2 = Format(CCur(pesq7), "#0.000")
      txtPhone2 = Format(CCur(pesq8), "#0.000")
      txtEmail = Format(CCur(pesq9), "#0.000")
      txtmn = Format(CCur(pesq10), "#0.000")
      txtti = Format(CCur(pesq11), "#0.000")
      txtal = Format(CCur(pesq12), "#0.000")
      txtcomplemento = pesq13
      If pesq14 <> "" Then
      txtDT = CDate(pesq14)
      End If
      txtIN = pesq15
      txtTR = pesq16
      ''If pesq17 <> "" Then
      txtPeso = Format(CCur(pesq17), "###,##0.000")
      ''End If
      txtPecas = pesq18
      ''If pesq19 <> "" Then
      txtPB = Format(CCur(pesq19), "###,##0.000")
      ''End If
      ''If pesq20 <> "" Then
      txtPL = Format(CCur(pesq20), "###,##0.000")
      ''End If
      If pesq21 <> "" Then
      txtDE = CDate(pesq21)
      End If
      txtDS = pesq22
      txtVT = pesq23
      Exit Sub
      trataErro:
         texto = "Não Localizado"
         mensagem = MsgBox(texto, vbOKOnly + vbInformation)
      End Sub
       
      'este altera na tabela
       
      Sub lsAlterarStudent()
          
          'Define a Range de Pesquisa
          Set currentFind = Worksheets("Clientes").Range("A:A").Find(frmCadastroStudents.lblCod, , _
              Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
              Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
              
          lLinha = currentFind.Row
          
          With frmCadastroStudents
              Sheets("Clientes").Cells(lLinha, 2).Value = CDate(.txtAddress)
              Sheets("Clientes").Cells(lLinha, 3).Value = .txtNumber
              Sheets("Clientes").Cells(lLinha, 4).Value = .txtNeighb
              Sheets("Clientes").Cells(lLinha, 5).Value = .txtCity
              Sheets("Clientes").Cells(lLinha, 6).Value = .cbUF
              Sheets("Clientes").Cells(lLinha, 7).Value = CCur(.txtDDD1)
              Sheets("Clientes").Cells(lLinha, 8).Value = CCur(.txtPhone1)
              Sheets("Clientes").Cells(lLinha, 9).Value = CCur(.txtDDD2)
              Sheets("Clientes").Cells(lLinha, 10).Value = CCur(.txtPhone2)
              Sheets("Clientes").Cells(lLinha, 11).Value = CCur(.txtEmail)
              Sheets("Clientes").Cells(lLinha, 12).Value = CCur(.txtmn)
              Sheets("Clientes").Cells(lLinha, 13).Value = CCur(.txtti)
              Sheets("Clientes").Cells(lLinha, 14).Value = CCur(.txtal)
              Sheets("Clientes").Cells(lLinha, 15).Value = .txtcomplemento
              Sheets("Clientes").Cells(lLinha, 16).Value = CDate(.txtDT)
              Sheets("Clientes").Cells(lLinha, 17).Value = .txtIN
              Sheets("Clientes").Cells(lLinha, 18).Value = .txtTR
              
          ''If txtPeso <> "" Then
              Sheets("Clientes").Cells(lLinha, 19).Value = CCur(.txtPeso)
          ''End If
              
              Sheets("Clientes").Cells(lLinha, 20).Value = .txtPecas
                      
          ''If txtPB <> "" Then
              Sheets("Clientes").Cells(lLinha, 21).Value = CCur(.txtPB)
          ''End If
              
          ''If txtPL <> "" Then
              Sheets("Clientes").Cells(lLinha, 22).Value = CCur(.txtPL)
          ''End If
              
          ''If txtDE <> "" Then
              Sheets("Clientes").Cells(lLinha, 23).Value = CDate(.txtDE)
          ''End If
          
              Sheets("Clientes").Cells(lLinha, 24).Value = .txtDS
              Sheets("Clientes").Cells(lLinha, 25).Value = .txtVT
              
          End With
      End Sub
       
       
×

Important Information

Ao usar o fórum, você concorda com nossos Terms of Use.