【已解决】如何获取Excel单元格中的“批注”信息？

xowen

如下图，如何获取到单元格中的批注信息？貌似没从文档中找到关于“注释”获取的UDF，求解。

kevinch

Func _ExcelGetComments($xlsobj,$getall=1)
        If Not IsObj($xlsobj) Then Return SetError(1)
        Switch StringLower(ObjName($xlsobj))
                Case "_application"
                        If $xlsobj.workbooks.count>0 Then
                                $xlsobj=$xlsobj.activeworkbook.activesheet.cells.specialcells(-4144)
                        Else
                                Return SetError(1)
                        EndIf
                Case "_workbook"
                        $xlsobj=$xlsobj.activesheet.cells.specialcells(-4144)
                Case "_worksheet"
                        $xlsobj=$xlsobj.cells.specialcells(-4144)
                Case "range"
                        $xlsobj=$xlsobj.cells.specialcells(-4144)
                Case Else
                        Return SetError(1)
        EndSwitch
        If IsObj($xlsobj) Then
                If $getall=1 Then
                        Dim $arr[$xlsobj.cells.count+1][2],$i=0
                        $arr[$i][0]=$xlsobj.cells.count
                        For $cell In $xlsobj
                                $i+=1
                                $arr[$i][0]=$cell.address(0,0)
                                $arr[$i][1]=$cell.comment.text
                        Next
                Else
                        Dim $arr[2]
                        $arr[0]=$xlsobj(1).address(0,0)
                        $arr[1]=$xlsobj(1).comment.text
                EndIf
                Return SetError(0,0,$arr)        
        Else
                Return SetError(1)
        EndIf
EndFunc

写了一个，先将就用
两个参数

第一个参数，传入的可以是如下对象：
excel进程对象：取活动工作簿，活动工作表里面的批注
工作簿对象：取活动工作表里面的批注
工作表对象：取指定工作表里的批注
单元格区域对象：取指定单元格区域内的批注

第二个参数：
默认为1，取参数一里指定的全部批注
更改为非1的值即只取参数一里的第一个批注

返回值：
第二个参数为1时返回一个二维数组，数组[0][0]记录批注数量，向下[$n][0]记录批注所在单元格地址，[$n][1]记录批注内容
第二个参数为非1的值时返回一个一维数组，第一个元素是批注单元格地址，第二个元素是批注文本内容
指定对象内没有批注或传入对象不符等情况下，返回错误值

附一个调用示例，可以制作一个含有批注的excel文档测试，打开文档后，执行下面代码

$excelapp=ObjGet("","excel.application")
If IsObj($excelapp) Then
        If $excelapp.workbooks.count>0 Then
                $xls=$excelapp.activeworkbook
                $rng=$xls.activesheet.range("a1:d8")
                ConsoleWrite("传入Excel 进程对象"&@CRLF)
                $arr=_ExcelGetComments($excelapp)
                If Not @error Then
                        For $n=1 To $arr[0][0]
                                ConsoleWrite($arr[$n][0]&@TAB&$arr[$n][1]&@CRLF)
                        Next
                EndIf
                ConsoleWrite("传入Excel 工作簿对象，并获取第一个批注"&@CRLF)
                $arr=_ExcelGetComments($xls,0)
                If Not @error Then ConsoleWrite($arr[0]&@TAB&$arr[1]&@CRLF)
                ConsoleWrite("传入Excel 工作表对象"&@CRLF)
                _ExcelGetComments($xls.activesheet)
                If Not @error Then
                        For $n=1 To $arr[0][0]
                                ConsoleWrite($arr[$n][0]&@TAB&$arr[$n][1]&@CRLF)
                        Next
                EndIf
                ConsoleWrite("传入Excel 单元格区域对象"&@CRLF)
                _ExcelGetComments($rng)
                If Not @error Then
                        For $n=1 To $arr[0][0]
                                ConsoleWrite($arr[$n][0]&@TAB&$arr[$n][1]&@CRLF)
                        Next
                EndIf
        EndIf
EndIf

Func _ExcelGetComments($xlsobj,$getall=1)
        If Not IsObj($xlsobj) Then Return SetError(1)
        Switch StringLower(ObjName($xlsobj))
                Case "_application"
                        If $xlsobj.workbooks.count>0 Then
                                $xlsobj=$xlsobj.activeworkbook.activesheet.cells.specialcells(-4144)
                        Else
                                Return SetError(1)
                        EndIf
                Case "_workbook"
                        $xlsobj=$xlsobj.activesheet.cells.specialcells(-4144)
                Case "_worksheet"
                        $xlsobj=$xlsobj.cells.specialcells(-4144)
                Case "range"
                        $xlsobj=$xlsobj.cells.specialcells(-4144)
                Case Else
                        Return SetError(1)
        EndSwitch
        If IsObj($xlsobj) Then
                If $getall=1 Then
                        Dim $arr[$xlsobj.cells.count+1][2],$i=0
                        $arr[$i][0]=$xlsobj.cells.count
                        For $cell In $xlsobj
                                $i+=1
                                $arr[$i][0]=$cell.address(0,0)
                                $arr[$i][1]=$cell.comment.text
                        Next
                Else
                        Dim $arr[2]
                        $arr[0]=$xlsobj(1).address(0,0)
                        $arr[1]=$xlsobj(1).comment.text
                EndIf
                Return SetError(0,0,$arr)        
        Else
                Return SetError(1)
        EndIf
EndFunc

ak47gglllk

膜拜，膜拜。收了先

imlzr

做个标记，以后慢慢看

h20040606

非常不错，收藏备用

xowen

厉害，谢谢了！。。。。

siton

NB啊，大仙啊。。

vigiles

mark，备用

jzw1201

做过记号，以后用得上。谢谢