Question

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

我的代码片段有效，但颜色除外，它会引发运行时错误＆＃39; 1004＆＃39;：字体大小必须介于1到409之间。

这很奇怪，因为尺寸有效，如果我注释掉颜色线（＆＃39;）就行了。

这是我的代码：

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

感谢您的帮助。

Answer 1

我更幸运使用 ColorIndex 而非颜色并首先着色：

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 中似乎存在错误

Answer 2

我终于找到了解决方案以及为什么代码的颜色会增加一个＆＃39;尺寸＆＃39;错误。

我确实喜欢你，首先给它上色，然后是第二个回路，

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

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

然后再做一次autosize = true，因为当然尺寸已经改变了！

我认为它类似于尝试在隐藏工作表中选择一个单元格，只是应用于评论

（颜色属性可能会重写每个有效的像素颜色，但他无法读取隐藏的像素（没有评论的形状大小），我对你有意义吗？）< / p>

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

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

enter image description here

将颜色设置为vba中注释的字符

2 个答案: