Ir ao conteúdo

Posts recomendados

Postado
17 horas atrás, Eri França disse:

 Olá a todos!

 

Com base na planilha anexa solicito a ajuda dos senhores.

Minha intenção é ao realizar um duplo clique no listview a planilha enviar os dados para os textbox equivalentes para poder alterar a informação e salvar

Agradeço qualquer ajuda.

BUSCA AVANÇADA COLEÇÃO V5.rar 269 kB · 1 download

@Basole Alguma dica mestre?

Postado

Bom dia amigos!

 

consegui uma certa evolução com o código abaixo

 

'Para carregar nos TextBoxs

Private Sub ListView1_DblClick()

'Seleciona uma linha no listview, e os dados são carregados no textbox
  Dim Carregar
 
  Carregar = (ListView1.SelectedItem.Index)
 
  Me.txt_ID.Value = ListView1.ListItems(Carregar)
  Me.txt_titulo = ListView1.ListItems(Carregar).ListSubItems(1).Text
  Me.txt_numero = ListView1.ListItems(Carregar).ListSubItems(2).Text
  Me.txt_data = ListView1.ListItems(Carregar).ListSubItems(3).Text
  Me.txt_licenciadora = ListView1.ListItems(Carregar).ListSubItems(4).Text
  Me.txt_editora = ListView1.ListItems(Carregar).ListSubItems(5).Text
 
     Me.txt_titulo.SetFocus
        
End Sub

 

'Para alterar a informação na ListView e na planilha

Private Sub Alteração_Click()
i = Plan1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1
       For j = 2 To i
If CInt(txt_ID) = CInt(Plan1.Cells(i, 1)) Then
           Plan1.Cells(i, 2) = UCase(txt_titulo)
           Plan1.Cells(i, 3) = UCase(txt_numero)
           Plan1.Cells(i, 4) = UCase(txt_data)
           Plan1.Cells(i, 5) = UCase(txt_licenciadora)
           Plan1.Cells(i, 6) = UCase(txt_editora)
           
           
    Exit For
        End If
    Next

    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i) = txt_ID Then
            ListView1.ListItems.Item(i).SubItems(1) = UCase(txt_titulo)
            ListView1.ListItems.Item(i).SubItems(2) = UCase(txt_numero)
            ListView1.ListItems.Item(i).SubItems(3) = UCase(txt_data)
            ListView1.ListItems.Item(i).SubItems(4) = UCase(txt_licenciadora)
            ListView1.ListItems.Item(i).SubItems(5) = UCase(txt_editora)
            
     Exit For
        End If
    Next

End Sub

 

Porém o código para alteração está alterando apenas o ListView, não salvando na planilha.

Alguma sugestão?

 

 

Postado

Use o find para encontar o dado na planilha, a partir dai voce terá a referencia da linha

  

Set Rng = .Range("A2:A1000").Find(What:= Me.txt_ID.Text, LookIn:=xlValues, LookAt:=xlWhole, _
                                    MatchCase:=False, SearchFormat:=False)

 

Postado

@Basole Desculpe a ignorância Basole, coloquei o código que me indica-se no Alteração_Click, e me retorna  erro de compilação: referência inválida ou não qualifica

Pode apontar o meu erro?

 

Private Sub Alteração_Click()

Set Rng = .Range("A2:A13000").Find(What:=Me.txt_ID.Text, LookIn:=xlValues, LookAt:=xlWhole, _
                                    MatchCase:=False, SearchFormat:=False)


i = Plan1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1
i = Plan1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

       For j = 2 To i
If CInt(txt_ID) = CInt(Plan1.Cells(i, 1)) Then
           Plan1.Cells(i, 2) = UCase(txt_titulo)
           Plan1.Cells(i, 3) = UCase(txt_numero)
           Plan1.Cells(i, 4) = UCase(txt_data)
           Plan1.Cells(i, 5) = UCase(txt_licenciadora)
           Plan1.Cells(i, 6) = UCase(txt_editora)
           
           
    Exit For
        End If
    Next

    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i) = txt_ID Then
            ListView1.ListItems.Item(i).SubItems(1) = UCase(txt_titulo)
            ListView1.ListItems.Item(i).SubItems(2) = UCase(txt_numero)
            ListView1.ListItems.Item(i).SubItems(3) = UCase(txt_data)
            ListView1.ListItems.Item(i).SubItems(4) = UCase(txt_licenciadora)
            ListView1.ListItems.Item(i).SubItems(5) = UCase(txt_editora)
            
     Exit For
        End If
    Next

End Sub

Postado

Veja o exemplo.

 

* Acrescente no codigo ActiveSheet.AutoFilterMode = False pois se os filtros estiverem halibitados não serão encontrados


  

Private Sub Alteração_Click()
Dim rng As Range
Dim UL  As Long

      UL = Plan1.Cells(Plan1.Rows.CountLarge, 1).End(xlUp).Row


Set rng = Plan1.Range("A2:A" & UL).Find(What:=Me.txt_ID.Text, LookIn:=xlValues, LookAt:=xlWhole, _
                                    MatchCase:=False, SearchFormat:=False)
             
             If Not rng Is Nothing Then
         
                 MsgBox " Dados Encontrados na linha: " & rng.Row
                 With Plan1
                      .Range("B" & rng.Row) = Me.txt_titulo.Text
                      .Range("C" & rng.Row) = Me.txt_numero.Text
                      .Range("D" & rng.Row) = VBA.Format(Me.txt_data.Value, "dd/mm/ýyyy")
                      .Range("E" & rng.Row) = txt_Licenciadora.Text
                      .Range("F" & rng.Row) = Me.txt_Editora.Text
                End With
             Else
               
                 MsgBox " Dados NAO Encontrados!!, Verifique"
                 
            End If
            
i = Plan1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1
i = Plan1.Cells(Cells.Rows.Count, "a").End(xlUp).Row + 1

       For j = 2 To i
If CInt(txt_ID) = CInt(Plan1.Cells(i, 1)) Then
           Plan1.Cells(i, 2) = UCase(txt_titulo)
           Plan1.Cells(i, 3) = UCase(txt_numero)
           Plan1.Cells(i, 4) = UCase(txt_data)
           Plan1.Cells(i, 5) = UCase(txt_Licenciadora)
           Plan1.Cells(i, 6) = UCase(txt_Editora)
           
           
    Exit For
        End If
    Next

    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i) = txt_ID Then
            ListView1.ListItems.Item(i).SubItems(1) = UCase(txt_titulo)
            ListView1.ListItems.Item(i).SubItems(2) = UCase(txt_numero)
            ListView1.ListItems.Item(i).SubItems(3) = UCase(txt_data)
            ListView1.ListItems.Item(i).SubItems(4) = UCase(txt_Licenciadora)
            ListView1.ListItems.Item(i).SubItems(5) = UCase(txt_Editora)
            
     Exit For
        End If
    Next

End Sub

 

  • Curtir 1

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Ebook grátis: Aprenda a ler resistores e capacitores!

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!