Vertically center comment in cell

[Pinball]

Is there code I can add to the following that will vertically center the comment? Actually I would like the comment vertically centered in the cell located to the immediate right of the active cell (cell G2 in this case). I don't want the comment sized to fit the row height, just to be centered vertically within the existing row height.

Sub test()
Range("F2").Activate
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select
With Selection
.ShapeRange.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
.ShapeRange.Fill.ForeColor.SchemeColor = 22
.ShapeRange.IncrementLeft -7.25
End With
ActiveCell.Comment.Text Text:="this is a test"
With ActiveCell.Comment.Shape.TextFrame.Characters.Font
.Bold = True
.ColorIndex = 5
End With
Range("F2").Activate
End Sub

[Robb__]

Pinball

Try this:

Sub test()
Range("F2").Activate
ActiveCell.ClearComments
ActiveCell.AddComment
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select
With Selection
.ShapeRange.ScaleHeight 0.2, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopLeft
.ShapeRange.Fill.ForeColor.SchemeColor = 22
.ShapeRange.IncrementLeft -7.25
If .ShapeRange.Height <= Rows(2).Height Then
.ShapeRange.Top = Rows(2).Top + (Rows(2).Height - .ShapeRange.Height) / 2
Else
.ShapeRange.Top = Rows(2).Top - (.ShapeRange.Height - Rows(2).Height) / 2
End If
End With
ActiveCell.Comment.Text Text:="this is a test"
With ActiveCell.Comment.Shape.TextFrame.Characters.Font
.Bold = True
.ColorIndex = 5
End With
Range("F2").Activate
End Sub

If you wanted, you could set variables, but this should give you the general idea.

Any help?

Regards

Robb__