Macro de criação de forma no excel

Sub TEXTOBALÃO()
Dim shp As Shape
Dim texto As String
Dim regex As Object
Dim matches As Object
Dim match As Object
Dim numero As Double
Dim textoFormatado As String
Dim inicio As Integer
Dim comprimento As Integer
Dim cor As Long
Dim numeroFormatado As String
Dim startPos As Integer
Dim endPos As Integer
Dim cel As Range
Dim celulas As Variant
Dim i As Integer

‘ Definindo as células a serem verificadas
celulas = Array(“C80”, “E80”, “G80”, “J80”, “L80”, “N80”, “Q80”, “S80”, “U80”, _
“C171”, “E171”, “G171”, “J171”, “L171”, “N171”, “Q171”, “S171”, “U171”)

‘ Criando a expressão regular para detectar números
Set regex = CreateObject(“VBScript.RegExp”)
regex.Global = True
regex.IgnoreCase = False
regex.Pattern = “-?\d+” ‘ Padrão para encontrar números, inclusive negativos

‘ Desabilitar atualização da tela para melhorar desempenho
Application.ScreenUpdating = False

‘ Iterar sobre as células
For i = LBound(celulas) To UBound(celulas)
Set cel = ActiveSheet.Range(celulas(i))
texto = cel.Value

‘ Verificar se o texto não está vazio e é válido
If Len(texto) > 0 Then
textoFormatado = texto
Set matches = regex.Execute(texto)

‘ Processar todos os números encontrados
For Each match In matches
On Error Resume Next
‘ Tentar converter para número
numero = CDbl(match.Value)
If Err.Number = 0 Then ‘ Verificar se a conversão foi bem-sucedida
‘ Formatar número para R$ X M
numeroFormatado = “R$ ” & Format(Abs(numero) / 1000000, “0.0”) & ” M,”
textoFormatado = Replace(textoFormatado, match.Value, numeroFormatado)
End If
On Error GoTo 0 ‘ Desabilitar a captura de erro após o uso
Next match

‘ Criar o balão de texto
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangularCallout, cel.Left, cel.Top + cel.Height + 5, 150, 100)

‘ Configurar a cor de fundo e borda do balão
With shp.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With

‘ Configurar a borda do balão
With shp.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 153, 153)
.Transparency = 0
.Weight = 0.25
End With

‘ Configurar o texto do balão
With shp.TextFrame2
.TextRange.text = textoFormatado
.TextRange.Font.Size = 7
.TextRange.Font.Fill.ForeColor.RGB = RGB(166, 166, 166)
.TextRange.ParagraphFormat.Alignment = msoAlignCenter
.VerticalAnchor = msoAnchorMiddle
End With

‘ Colorir o texto baseado no valor (positivo ou negativo)
startPos = InStr(textoFormatado, “R$”)
For Each match In matches
If startPos > 0 Then
endPos = InStr(startPos + 3, textoFormatado, ” M,”)

If endPos > 0 Then
If CDbl(match.Value) < 0 Then
cor = RGB(192, 0, 0) ' Vermelho para negativo
Else
cor = RGB(0, 128, 0) ' Verde para positivo
End If

shp.TextFrame2.TextRange.Characters(startPos, endPos – startPos + 3).Font.Fill.ForeColor.RGB = cor
End If
End If
startPos = InStr(startPos + 1, textoFormatado, "R$")
Next match
End If
Next i

' Reabilitar atualização da tela após a execução do código
Application.ScreenUpdating = True

End Sub