Saberexcel - o site das macros
Macro ao Aplicativo Microsoft Excel VBA, arredonda comentarios nos cantos

Sub Adiciona_arredondando_comentario()
Application.ScreenUpdating = False
On Error GoTo ErrorSaber
With ActiveCell
.AddComment
.Comment.Visible = True
.Comment.Shape.AutoShapeType = msoShapeRoundedRectangle
.Comment.Shape.Select True
.Comment.Text Text:="Aprenda Microsoft Excel VBA com qualidade Saberexcel"
End With
With Selection
.Font.Size = 8
.ShapeRange.Shadow.Visible = msoFalse
.ShapeRange.ScaleWidth 1.2, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
.ShapeRange.Adjustments.Item(1) = 0.25
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
ErrorSaber:
Application.ScreenUpdating = True
End Sub

'Macro auxiliar usada nos testes com medidas diferentes e arredondados nos cantos
Sub Adiciona_arredondando_comentario_II()
Application.ScreenUpdating = False
On Error GoTo ErrorSaber
With ActiveCell
.AddComment
.Comment.Visible = True
.Comment.Shape.AutoShapeType = msoShapeRoundedRectangle
.Comment.Shape.Select True
.Comment.Text Text:="Aprenda Microsoft Excel VBA com qualidade Saberexcel"
End With
With Selection
.Font.Size = 11
.ShapeRange.Shadow.Visible = msoFalse
.ShapeRange.ScaleWidth 1.6, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 1.3, msoFalse, msoScaleFromTopLeft
.ShapeRange.Adjustments.Item(1) = 4.25
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter

End With
ErrorSaber:
Application.ScreenUpdating = True
End Sub

Macro auxiliar para os testes dos alunos desenvolvedores
Sub deleta_todos_teste()
Dim resposta As String
resposta = MsgBox("Deseja deletar todos os comentarios para teste?", vbYesNo + vbCritical, _
"Saberexcel - Site das Macros")
If resposta = 6 Then '=sim
For Each sb In ActiveSheet.Comments
sb.Delete
Next
End If
End Sub


Aprenda Microsoft Excel VBA(Visual Basic Application) com qualidade Saberexcel

Saberexcel - dicas de macros microsoft excel vba

Essa macro do aplicativo Microsoft Excel VBA adiciona um um texto a um comentario a partir da célula ativa.

Sub adicionando_comentario_com_texto()
On Error Resume Next
ActiveCell.AddComment
ActiveCell.Comment.Text Text:=ActiveCell.Text
End Sub

'Macro auxiliar para os testes dos alunos desenvolvedores
Sub deleta_todos_teste()
Dim resposta As String
resposta = MsgBox("Deseja deletar todos os comentarios para teste?", vbYesNo + vbCritical, _
"Saberexcel - Site das Macros")
If resposta = 6 Then '=sim
For Each sb In ActiveSheet.Comments
sb.Delete
Next
End If
End Sub

Aprenda Microsoft Excel VBA com qualidade Saberexcel

SaberExcel - o site das macros

Esta macro do Aplicativo Microsoft Excel VBA, insere um comentário falso na folha de planilha,
isto é insere autoformas que imitam um comentário, um pequeno triângulo vermelho representando
o indicador do comentário (no canto superior esquerdo da célula) e um retangulo contendo o comentário
propriamente dito, obtido atraves de um inputbox(entrada de dados).

Sub Falso_Comentario()
Dim com As String
Dim aSh As Worksheet
Dim cloneC As Shape

com = InputBox("Insira seu comentário.....", "Inserir comentário que será falso")

If com <> "" Then
On Error Resume Next

With Selection.Validation
.Add Type:=xlValidateInputOnly
.InputTitle = "Falso comentário :"
.InputMessage = com
End With

Else: Exit Sub
End If

Application.ScreenUpdating = False

Set aSh = ActiveSheet
Set poZ = ActiveCell

p1 = poZ.Top
p2 = poZ.Left

Set cloneC = aSh.Shapes.AddShape(msoShapeRightTriangle, _
p2, p1, 5#, 5#)

With cloneC
.IncrementRotation 90#
.Fill.ForeColor.SchemeColor = 10
.Line.Visible = msoFalse
End With
End Sub

Aprenda Aplicativo Microsoft Excel VBA --((SaberExcel))--

Saberexcel - o site das macros
Caro E_Marcondes, sou programador e preciso de uma macro, que insere um triângulo azul no lugar do indicador(vermelho) do comentário,
eu tinha mas acabei perdendo, se você tiver, será que poderia me enviar, obrigado. Reginaldo
Sim tenho sim, junto à minha coleção de 15.000 macros achei, na verdade é uma macro servida de uma função:
Cor do triângulo do indicador do comentário em azul

'Option Explicit

Sub Criar_triangulo_indicador_comentario()
vCriarIndicador vbBlue, "EPM"
End Sub


Public Function vCriarIndicador(CommentIndicatorColor As Long, _
CommentIndicatorName As String) As Boolean
'
Dim IDnumber As Long
Dim aCell As Range
Dim aComment As Comment
Dim aShape As Shape
Dim aWorksheet As Worksheet
Dim aWorkbook As Workbook

vCriarIndicador = False

If CommentIndicatorName = vbNullString Then GoTo ExitFunction
On Error GoTo ExitFunction
Set aWorkbook = ActiveWorkbook

IDnumber = 0
'loop through all wprksheets in the active workbook and all comments
'in each worksheet and create the comment shapes

For Each aWorksheet In aWorkbook.Worksheets
For Each aShape In aWorksheet.Shapes
If Left(aShape.Name, Len(CommentIndicatorName)) = _
CommentIndicatorName Then
aShape.Delete
End If
Next aShape

For Each aComment In aWorksheet.Comments

Set aCell = aComment.Parent

If InStr(1, aComment.Shape.TextFrame.Characters.Text, ":") > 0 Then
If Left(aComment.Shape.TextFrame.Characters.Text, InStr(1, aComment.Shape.TextFrame.Characters.Text, ":") - 1) = Application.UserName Then

GoSub CreateCommentIndicator

End If
End If
Next aComment
Next aWorksheet

vCriarIndicador = True
ExitFunction:

On Error GoTo 0
Set aCell = Nothing
Set aComment = Nothing
Set aShape = Nothing
Set aWorksheet = Nothing
Set aWorkbook = Nothing
Exit Function

CreateCommentIndicator:

Set aShape = aWorksheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=aCell.Left + aCell.Width - 5, _
Top:=aCell.Top, _
Width:=5, _
Height:=5)
IDnumber = IDnumber + 1
With aShape
.Name = CommentIndicatorName & CStr(IDnumber)
.IncrementRotation -180#
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = CommentIndicatorColor
.Line.Visible = msoTrue
.Line.Weight = 1
.Line.Style = msoLineSingle
.Line.DashStyle = msoLineSolid
.Line.ForeColor.RGB = CommentIndicatorColor
.Placement = xlMove
End With
Return
End Function



Aprenda Microsoft Excel VBA (( Saberexcel ))

Dicas Microsoft Excel VBA(Visual Basic Application)
SaberExcel


TODAS AS FÓRMULAS EXISTENTES NA FOLHA DE PLANILHA EM COMENTÁRIOS
'Esta macro insere as formulas usadas em comentarios,
'Todas as formulas usadas na folha de planilha

Sub Formulas_em_Comentarios()
Dim cell, Largura, Altura

On Error Resume Next

For Each cell In ActiveSheet.UsedRange
If cell.HasFormula Then
cell.AddComment
cell.Comment.Text Text:=cell.FormulaLocal
With cell.Comment.Shape
Largura = .Width
Altura = .Height
.TextFrame.AutoSize = True

If .Width > 350 Then
.Width = 350
.Height = 55
End If

End With
End If
Next
Saber1.Shapes("sb1").Visible = True
Saber1.Shapes("sba").Visible = False
End Sub

'Macro para deletar todos os comentários inseridos na planilha.
Sub Deleta_comentarios()
For i = ActiveSheet.Comments.Count To 1 Step -1
ActiveSheet.Comments(i).Delete
Next i
Saber1.Shapes("sba").Visible = True
Saber1.Shapes("sb1").Visible = False
End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com Saberexcel

Baixar exemplo de planilha excel vba contendo a macro acima

Publicidade:

Compras pela internet com muita segurança e bons preços