Question

有两张我正在使用Vlookup功能的表格，它运行良好，除非它没有将另一张表格中的单元格注释带到我使用Vlookup的那张表格上。评论中只有背景图片，没有文字。我已经google了一下，并提出了这个自定义的Vlookup代码，该代码在单元格没有评论时有效，但在它出现时不会带来图片/评论

Function VlookupComment(lookval As Variant, Ftable As Range, Fcolumn As 
Long, Ftype As Long) As Variant
Application.Volatile
Dim xRet As Variant
Dim xCell As Range
xRet = Application.Match(lookval, Ftable.Columns(1), Ftype)
If IsError(xRet) Then
    VlookupComment = "Not Found"
Else
    Set xCell = Ftable.Columns(Fcolumn).Cells(1)(xRet)
    VlookupComment = xCell.Value
    With Application.Caller
        If Not .Comment Is Nothing Then
            .Comment.Delete
        End If
        If Not xCell.Comment Is Nothing Then
        xCell.Comment.Visible = True
        xCell.Comment.Shape.Select
        xCell.Comment.Shape.CopyPicture _
            Appearance:=xlScreen, Format:=xlPicture
        xCell.Comment.Visible = False

            .AddComment
            .Comment.PasteSpecial

        End If
     End With
End If

我尝试了一些不同的东西，但结果相同，我对VBA并不熟悉，但对VB.NET有很好的理解，所以我只是在努力学习excel特定的功能。谁能看到我需要改变的东西？

Answer 1

要将图片从一个评论传递到相同工作表中的另一个评论，您可以使用.Pickup和.Apply方法，如下所示：

Function VlookupComment(lookval As Variant, Ftable As Range, _
                        Fcolumn As Long, Ftype As Long) As Variant

    Application.Volatile
    Dim xRet As Variant
    Dim xCell As Range
    xRet = Application.Match(lookval, Ftable.Columns(1), Ftype)
    If IsError(xRet) Then
        VlookupComment = "Not Found"
    Else
        Set xCell = Ftable.Columns(Fcolumn).Cells(1)(xRet)
        VlookupComment = xCell.Value
        With Application.Caller
            If Not .Comment Is Nothing Then
                .Comment.Delete
            End If
            If Not xCell.Comment Is Nothing Then
            xCell.Comment.Visible = True
            xCell.Comment.Shape.Select
            xCell.Comment.Shape.PickUp

            .AddComment
            .Comment.Shape.Apply

            End If
         End With
    End If

End Function

在阅读您的评论并进行一些测试之后，似乎必须激活其注释所引用的单元格的工作表以避免错误70：权限被拒绝。

这意味着在表格中使用此公式，您需要在代码中激活工作表，但为了避免任何屏幕闪烁，我建议您先手动停用screenupdating，如下所示：

Function VlookupComment(lookval As Variant, Ftable As Range, _
                        Fcolumn As Long, Ftype As Long) As Variant

    Application.Volatile
    Dim xRet As Variant
    Dim xCell As Range
    xRet = Application.Match(lookval, Ftable.Columns(1), Ftype)
    If IsError(xRet) Then
        VlookupComment = "Not Found"
    Else
        Set xCell = Ftable.Columns(Fcolumn).Cells(1)(xRet)
        VlookupComment = xCell.Value
        With Application.Caller
            If Not .Comment Is Nothing Then
                .Comment.Delete
            End If
            If Not xCell.Comment Is Nothing Then
            xCell.Comment.Visible = True
            'xCell.Comment.Shape.Select

            Application.ScreenUpdating = False
                xCell.Parent.Activate
                xCell.Comment.Shape.PickUp

                .Parent.Activate
                .AddComment
                .Comment.Shape.Apply
            Application.ScreenUpdating = True

            End If
         End With
    End If

End Function

希望激活工作表不会减慢功能执行太多。

从单元格注释中提取背景图片并将其转移到另一个单元格上的另一个单元格注释？

1 个答案: