【VBA】選択したセルに吹き出しを配置するマクロ

'選択したセルに吹き出しを挿入
Sub insBalloon()
　
　Dim Bar As Shape
　Dim cell As String
　
　'アクティブセルを取得
　cell = ActiveCell.address
　
　If cell <> "" Then
　　Set Bar = ActiveSheet.Shapes.AddShape _
　　　(msoShapeRoundedRectangularCallout, _
　　　　Range(cell).Left, _
　　　　Range(cell).Top, _
　　　　170, _
　　　　50)
　　
　　'枠内の書式設定
　　With Bar.Fill
　　　.Visible = msoTrue
　　　.ForeColor.TintAndShade = 0
　　　.ForeColor.Brightness = 0
　　　.Transparency = 0
　　　.Solid
　　End With
　　
　　'枠の書式設定
　　With Bar.Line
　　　.Visible = msoTrue
　　　.ForeColor.TintAndShade = 0
　　　.ForeColor.Brightness = 0
　　　.Transparency = 0
　　End With
　　
　　'枠内のテキストの書式設定
　　With Bar.TextFrame2
　　　.VerticalAnchor = msoAnchorMiddle
　　　.TextRange.ParagraphFormat.Alignment = msoAlignCenter
　　　.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
　　End With
　　
　　'図形スタイルの設定
　　Bar.ShapeStyle = msoShapeStylePreset7
　　
　　'吹き出しの方向設定
　　With Bar.Adjustments
　　　.Item(1) = -0.4
　　　.Item(2) = 1
　　End With
　End If
End Sub

青い図形にする場合は図形スタイルを以下に変え、

Bar.ShapeStyle = msoShapeStylePreset13

文字色を以下に変えればいいかなと

.TextRange.Font.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1

サイズは適当

以上