【VBA】選択したセルにテキストを配置するマクロ

'選択したセルにテキストを配置
Sub insText()
　
　Dim Bar As Shape
　Dim cell As String
　
　'アクティブセルを取得
　cell = ActiveCell.address
　
　If cell <> "" Then
　　Set Bar = ActiveSheet.Shapes.AddShape _
　　　(msoShapeRectangle, _
　　　　Range(cell).Left, _
　　　　Range(cell).Top, _
　　　　180, _
　　　　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
　　
　End If
End Sub

サイズは適当

以上