| Descricao: |
 SaberExcel VBA Estudos®
Essa macro do Aplicativo Microsoft Excel VBA, insere um comentário formatado em vermelho, na célula ativa da folha de planilha, o retorno do comentário é auxiliado por uma inputbox,
Option Explicit
Sub Comentario_Celula()
Dim rnCell As Range
Dim SbNome As String
Dim vlr_Comentario As Variant
Dim iEventos As Integer
Dim resposta As String
SbNome = Application.UserName
Set rnCell = ActiveCell
With rnCell
'Caso nao exista comentario na celula
resposta = MsgBox("Deseja inserir um comentario na célula ativa?", vbYesNo, "Saberexcel - site das macros")
If resposta = vbYes Then
If .Comment Is Nothing Then
'Comentario digitado pelo usuario
vlr_Comentario = Application.InputBox _
("Digite seu comentario:", "Comentario na celula e formata", Default:="Saberexcel.com", Type:=2)
'fecha a caixa de dialogo com o botao cancelar
If vlr_Comentario = False Then Exit Sub
'Aqui é o nome do usuario e o comentario da celula
.AddComment Text:=SbNome & ":" & vbLf & vlr_Comentario
'Aqui formata a celula do comentario
With .Comment.Shape.TextFrame
With .Characters.Font
.Size = 11
.ColorIndex = 3
.Name = "Arial"
End With
.AutoSize = True
'o nome do usuario em negrito
.Characters(Start:=1, Length:=Len(SbNome)).Font.Bold = True
End With
Else
'verifica se a celula já tem comentario
iEventos = MsgBox("Deseja remover a célula comentário ?", vbYesNoCancel, "Excluir Comentario")
Select Case iEventos
Case vbYes
.Comment.Delete
Exit Sub
Case vbCancel
Exit Sub
Case vbNo
vlr_Comentario = Application.InputBox _
("Digite o texto comentar aqui :", "Inserir / Editar célula comentário ", Default:="Saberexcel.com", Type:=2)
If vlr_Comentario = False Then Exit Sub
.Comment.Delete
.AddComment Text:=SbNome & ":" & vbLf & vlr_Comentario
End Select
End If
End If
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub
Aprenda tudo sobre Aplicativo Microsoft Excel VBA com Saberexcel
 Baixe o exemplo de planilha contendo a macro acima
Publicidade:
Compre com segurança, garantia e preços baixos nas lojas submarino
|