Excel 将颜色设置为注释'；vba中的s字符

我需要将Excel中的单元格从一个区域复制到另一个区域的注释，同时保持其格式（大小、粗体、颜色、斜体…）

我的代码可以正常工作，除了color，它抛出了一个运行时错误“1004”： 字体大小必须介于1到409点之间

这很奇怪，因为大小是有效的，如果我注释掉颜色线（'），它就有效了

这是我的密码：

Option Explicit

Function Comment_Format(ByVal Rg_Value As Range, ByVal Rg_Com As Range) As Comment
Dim i As Long, a As Long
If Rg_Com.Comment Is Nothing Then Rg_Com.AddComment
With Rg_Com.Comment
    .Text Text:=Rg_Value.Value2
    .Shape.TextFrame.AutoSize = True
End With

For i = 1 To Len(Rg_Value.Value2)
    With Rg_Com.Comment.Shape.TextFrame.Characters(i, 1).Font
        .Size = Rg_Value.Characters(i, 1).Font.Size
        'a = Rg_Value.Characters(i, 1).Font.Color
        'If a > 0 Then .Color = a    '  <<<<<<<<<<<<<<< this line shows the error !!
        .FontStyle = Rg_Value.Characters(i, 1).Font.FontStyle
    End With
Next i
Set Comment_Format = Rg_Com.Comment
End Function


Sub test()
Dim com As Comment

Set com = Comment_Format(Range("a1"), Range("b1"))
End Sub

选项显式
函数注释格式（ByVal Rg_值作为范围，ByVal Rg_Com作为范围）作为注释
朦胧的我一样长，一个一样长
如果Rg_Com.Comment为空，则Rg_Com.AddComment为空
用Rg_Com.Comment
.Text文本：=Rg_Value.Value2
.Shape.TextFrame.AutoSize=True
以
对于i=1到Len（Rg_值。值2）
使用Rg_Com.Comment.Shape.TextFrame.Characters（i，1）.Font
.Size=Rg_值.Characters（i，1）.Font.Size
'a=Rg_值.字符（i，1）.Font.Color
“如果a>0，那么.Color=a”我最好使用ColorIndex而不是Color并先着色：

Sub MAIN2()
    Call Comment_Format(Range("a1"), Range("b1"))
End Sub

Sub Comment_Format(Rg_Value As Range, Rg_Com As Range)
    Dim i As Long
    With Rg_Com
        .ClearComments
        .AddComment
        .Comment.Text Text:=Rg_Value.Text
        L = Len(Rg_Value.Text)

        For i = 1 To L
            .Comment.Shape.TextFrame.Characters(i, 1).Font.ColorIndex = Range("A1").Characters(i, 1).Font.ColorIndex
        Next i
    End With

    For i = 1 To L
        With Rg_Com.Comment.Shape.TextFrame.Characters(i, 1).Font
            .Size = Rg_Value.Characters(i, 1).Font.Size
            .Bold = Rg_Value.Characters(i, 1).Font.Bold
            .Italic = Rg_Value.Characters(i, 1).Font.Italic
        End With
    Next i

End Sub

这对我来说是：


编辑#1:

Excel 2007/Win 7在处理带有注释的颜色过程中似乎出现了一个错误
我终于找到了解决方案，以及为什么颜色代码行会出现“大小”错误

我真的很喜欢你，先给它涂上颜色，然后再涂上第二圈

但是在第一个循环之前添加了自动调整大小（因为我的文本很大），然后是颜色循环

然后是第二个循环（包括大小）

然后做第二次autosize=true，因为球场大小改变了

我认为这有点像试图在一个隐藏的工作表中选择一个单元格，只是应用于注释

（color属性可能会重写每个活动像素的颜色，但他无法“读取”隐藏像素（超出注释的形状大小），我对您有什么意义吗？）

最终代码，工作（任意大小的文本）：

选项显式
函数注释格式（ByVal Rg_值作为范围，ByVal Rg_Com作为范围）作为注释
'设置Rg_值=文本的范围（“A1”）'原点
“Set Rg_Com=Range（“b1”）”包含注释的目标单元格
Dim i As Long“简单循环计数器
Dim ff As Font'我使用了一个变量来表示长时间重复的垃圾代码（Rg_Value.Characters（i，1）.Font）
尺寸L与文本长度相同（我的示例中我的长度为508）
如果Rg_Com.Comment为空，则Rg_Com.AddComment为空
与Rg_Com
.ClearComments
.AddComment
有。评论
.Text Text:=Rg_Value.Text
.Shape.TextFrame.AutoSize=True“您是否尝试过使用Sub而不是函数？刚刚尝试过，结果相同（颜色不起作用）。顺便说一句，速度非常慢，因此我尝试在变量中传递Rg_值，但没有成功（它丢失所有格式设置），它可以为我找到，使用带有三种颜色的短字符串。有没有什么特别的颜色会导致它失败？如果我没记错的话，我在文本的一部分使用了标准橙色。我现在使用了
。colorindex
，为了排除故障，我在错误恢复下一步中添加了
您使用的是Excel 2007吗？
Option Explicit

Function Comment_Format(ByVal Rg_Value As Range, ByVal Rg_Com As Range) As Comment

'Set Rg_Value = Range("A1")  'origin of the text
'Set Rg_Com = Range("b1")    'destination cell containing the comment

Dim i As Long   'simple loop counter
Dim ff As Font  'i used a variable for the long repeating garbage code (Rg_Value.Characters(i, 1).Font)
Dim L As Long   ' lenght of text (mine is 508 in my sample)

If Rg_Com.Comment Is Nothing Then Rg_Com.AddComment
With Rg_Com
    .ClearComments
    .AddComment
    With .Comment
    .Text Text:=Rg_Value.Text
        .Shape.TextFrame.AutoSize = True  '<<< just to make all text visible in one comment, all chars having the basic size
    End With
End With

'On Error Resume Next

L = Len(Rg_Value.Text)

    For i = 1 To L
        Set ff = Rg_Value.Characters(i, 1).Font
        With Rg_Com.Comment.Shape.TextFrame.Characters(i, 1).Font
            .ColorIndex = ff.ColorIndex
        End With
    Next i


    For i = 1 To L
        Set ff = Rg_Value.Characters(i, 1).Font
        With Rg_Com.Comment.Shape.TextFrame.Characters(i, 1).Font
            .Size = ff.Size
            .Bold = ff.Bold
            .Italic = ff.Italic
            .Underline = ff.Underline
        End With
    Next i


Rg_Com.Comment.Shape.TextFrame.AutoSize = True  ' <<< now chars of the comment's text already have different sizes, and i need to resize the shape

'On Error GoTo 0

Set Rg_Value = Nothing
Set Rg_Com = Nothing

End Function


Sub test()
Dim com As Comment
With Application
    .EnableEvents = False
    .ScreenUpdating = False    'tryed to make it faster, but still uber slow (25 seconds for my 508     characters sample text)
    .Calculation = xlCalculationManual
End With

Set com = Comment_Format(Range("a1"), Range("b1"))
Beep            'wakes me up when the looping is over
Set com = Nothing

With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub