Notifications
Clear all

inserir comentário a partir de texto

3 Posts
1 Usuários
0 Reactions
865 Visualizações
(@juliowd)
Posts: 0
New Member
Topic starter
 

Olá. Eu estou precisando inserir um comentário numa célula a partir do conteúdo de uma outra célula.
Estou usando este código abaixo para fazer as transcrições. Porém gostaria de que na última transcrição o conteúdo da célula W, da aba PORTFÓLIO, virasse o comentário da célula AB da aba PROSPECÇÃO.
Eu encontrei um código que faz isso, mas não consegui adaptar na minha FOR.

Meu código:
Sub definir_contatos()

Plan1.Select
Plan1.Range("c4:o53").ClearContents
Plan1.Range("q4:ab53").ClearContents
Sheet2.Select

Z = 4

For i = 1 To 200

If Sheet2.Range("e" & i) = "o" Then

Plan1.Range("F" & Z) = Sheet2.Range("B" & i)
Plan1.Range("G" & Z) = Sheet2.Range("C" & i)
Plan1.Range("H" & Z) = Sheet2.Range("D" & i)
Plan1.Range("I" & Z) = Sheet2.Range("H" & i)
Plan1.Range("J" & Z) = Sheet2.Range("I" & i)
Plan1.Range("K" & Z) = Sheet2.Range("J" & i)
Plan1.Range("L" & Z) = Sheet2.Range("K" & i)
Plan1.Range("M" & Z) = Sheet2.Range("L" & i)
Plan1.Range("N" & Z) = Sheet2.Range("M" & i)
Plan1.Range("O" & Z) = Sheet2.Range("N" & i)
Plan1.Range("Q" & Z) = Sheet2.Range("O" & i)
Plan1.Range("R" & Z) = Sheet2.Range("P" & i)
Plan1.Range("S" & Z) = Sheet2.Range("Q" & i)
Plan1.Range("T" & Z) = Sheet2.Range("R" & i)
Plan1.Range("U" & Z) = Sheet2.Range("S" & i)
Plan1.Range("V" & Z) = Sheet2.Range("T" & i)
Plan1.Range("W" & Z) = Sheet2.Range("U" & i)
Plan1.Range("AB" & Z) = Sheet2.Range("W" & i) 'aqui é onde preciso fazer este procedimento.

Z = Z + 1

End If

Next

Plan1.Select
Range("b2").Select

End Sub

Abaixo o código que encontrei na internet, mas que não consegui migrar:

Dim sTexto As String
'recolhe o texto da celula A1
sTexto = Sheet2.Range("W" & i)
'só avança caso haja conteudo para o comentário
If Len(sTexto) = 0 Then Exit Sub
'usar a celula activa
With ActiveCell
'evita erros ao eliminar ou adicionar o comentário
On Error Resume Next
'eliminar comentário caso exista
.Comment.Delete
'Adicionar novo
.AddComment
'Estado do comentário
.Comment.Visible = False
'Inserir texto
.Comment.Text Text:=sTexto
End With

Obrigado desde já!!!!

 
Postado : 28/08/2014 6:42 am
(@juliowd)
Posts: 0
New Member
Topic starter
 

ah, lembrei de uma coisa. Toda vez que ele inserir um novo comentário, precisaria limpar o antigo......

 
Postado : 28/08/2014 6:45 am
(@juliowd)
Posts: 0
New Member
Topic starter
 

Oi!
Descobri como faço pra adaptar. E funcionou. Segue código, caso haja curiosidade.

Sub definir_contatos()

Plan1.Select
Plan1.Range("c4:o53").ClearContents
Plan1.Range("q4:ab53").ClearContents
Sheet2.Select

Z = 4
        
For i = 1 To 200

If Sheet2.Range("e" & i) = "o" Then

Plan1.Range("F" & Z) = Sheet2.Range("B" & i)
Plan1.Range("G" & Z) = Sheet2.Range("C" & i)
Plan1.Range("H" & Z) = Sheet2.Range("D" & i)
Plan1.Range("I" & Z) = Sheet2.Range("H" & i)
Plan1.Range("J" & Z) = Sheet2.Range("I" & i)
Plan1.Range("K" & Z) = Sheet2.Range("J" & i)
Plan1.Range("L" & Z) = Sheet2.Range("K" & i)
Plan1.Range("M" & Z) = Sheet2.Range("L" & i)
Plan1.Range("N" & Z) = Sheet2.Range("M" & i)
Plan1.Range("O" & Z) = Sheet2.Range("N" & i)
Plan1.Range("Q" & Z) = Sheet2.Range("O" & i)
Plan1.Range("R" & Z) = Sheet2.Range("P" & i)
Plan1.Range("S" & Z) = Sheet2.Range("Q" & i)
Plan1.Range("T" & Z) = Sheet2.Range("R" & i)
Plan1.Range("U" & Z) = Sheet2.Range("S" & i)
Plan1.Range("V" & Z) = Sheet2.Range("T" & i)
Sheet2.Range("zz1") = Sheet2.Range("W" & i)

Dim sTexto As String
   'recolhe o texto da celula A1
    sTexto = Sheet2.Range("zz1")
   'só avança caso haja conteudo para o comentário
    If Len(sTexto) = 0 Then Exit Sub
   'usar a celula activa
    With Plan1.Range("AB" & Z)
       'evita erros ao eliminar ou adicionar o comentário
        On Error Resume Next
       'eliminar comentário caso exista
        .Comment.Delete
       'Adicionar novo
        .AddComment
       'Estado do comentário
        .Comment.Visible = False
       'Inserir texto
        .Comment.Text Text:=sTexto
  End With

 
Z = Z + 1

End If

Next

Plan1.Select
Range("b2").Select


End Sub

Se encontrarem outra solução, seria legal também.
Abraço!

 
Postado : 28/08/2014 8:43 am