excel 用vba语言怎么在一个单元格里插入一个红色填充圆球

用录制宏加上简单的修改就可以做到

第一步，录制修改单元格宽度与高度的过程，得到代码

过程：录制宏，选定一个单元格，随意设置长和宽，比如宽15高6，结束录制，得到代码

Selection.RowHeight = 15
Selection.ColumnWidth = 6

 这样我们就知道了如何表示选中单元格的宽和和高，用x表示宽，y表示高

x = Selection.RowHeight
y = Selection.ColumnWidth

比较宽与高的大小，较小的值就是单元格中圆的直径，用d表示圆的直径

if x>y then
d = y
else
d = x
endif

 第二步，录制宏，在单元格中插入特殊符号几何图形●，设置为红色，并设置字符大小，得到代码

比如在单元格输入一个字号为14的红色的圆

ActiveCell.FormulaR1C1 = "●"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
        .Name = "宋体"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With

 第三步，把Size改成前面得到的直径，试试能不能成功……

Sub 插入红色的圆()

Dim x As Integer
Dim y As Integer
Dim d As Integer

x = Selection.RowHeight
y = Selection.ColumnWidth

If x > y Then
d = y
Else
d = x
End If

ActiveCell.FormulaR1C1 = "●"
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
        .Name = "宋体"
        .Size = d
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
    End With
End Sub

试了下，确实能插入红色的圆，但尺寸却是固定的……不知道是哪里出错了……

应该是得到选中单元格单元格宽度与高度的代码出问题了

[2015/2/20 10:39]宽度与高度的单位是像素，字号的单位是磅，需要换算

[2015/2/20 10:43]像素与字号的换算比较麻烦，我暂时无法做到，十分抱歉。

http://tieba.baidu.com/p/3294291403