本帖最后由 jmxhyz 于 2016-4-24 22:58 编辑
[Visual Basic] 纯文本查看 复制代码
REM ***** BASIC *****
REM 以下代码主要功能:
REM 1、选择要查找定位的区域
REM TODO:如果没有指定区域(当前只选中一个单元格),那么自动扩展选择区域
REM 2、选择所需要的定位条件(运行相应的Sub过程)
REM TODO:添加设置对话框(模仿Excel的定位对话框),根据用户选择运行相应的Sub
REM 3、返回:在工作表上选中所有找到的单元格
REM TODO:添加结果显示框(或者在设置对话框下加List控件),
REM 把定位结果添加到List(包括单元格地址及其当前内容,
REM 参考“查找与替换”的“全部查找”的“搜索结果”对话框)
REM 点击List上某单元格地址,再定位到工作表上相应单元格
'根据单元格内容的类型查找
'似乎LibreOffice有Bug,无法定位批注单元格
Sub location_CellContent
oDoc = ThisComponent
oController = oDoc.getCurrentController
oSheet = oController.activeSheet
oSel = oDoc.getCurrentSelection()
oCells = oSel.queryContentCells(23) 'Find the cells with content
REM queryContentCells() looks for cells with certain kinds of content.
REM Pure Values = 1, DateTime = 2, String = 4, Annotation = 8, Formula = 16,
REM HARDATTR = 32, STYLES = 64, OBJECTS = 128, EDITATTR = 256, FORMATTED = 512
REM See [url=http://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1sheet_1_1CellFlags.html]http://api.libreoffice.org/docs/ ... t_1_1CellFlags.html[/url]
REM I chose to search for Values, DateTimes, Strings and Formulas. The search value is then 1 + 2 + 4 + 16 = 23
thiscomponent.currentController.select(oCells)
End Sub
'列中差异值 queryColumnDifferences
'行中差异值
Sub location_RowDifferences
oDoc = ThisComponent
oController = oDoc.getCurrentController
oSheet = oController.activeSheet
oSel = oDoc.getCurrentSelection()
' xray oSel
REM 检测多重选择区域
If not oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
MsgBox "mulit selct"
Exit sub
End If
oRanges = ThisComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
Dim sCellAddress As New com.sun.star.table.CellAddress
oCellAddress = oSel.RangeAddress
If oCellAddress.EndColumn <= StartColumn Then
msgbox "选择行区域"
Exit Sub
End if
For i = oCellAddress.StartRow To oCellAddress.EndRow
sCellAddress.Sheet = oCellAddress.Sheet
sCellAddress.Column = oCellAddress.StartColumn
sCellAddress.Row = i
oFilter = oSel.queryRowDifferences(sCellAddress)
'xray oFilter
aRange = oFilter.RangeAddresses
For j = 0 To UBound(aRange)
oRanges.addRangeAddress(aRange(j), False) 'Merge
Next
Next
thiscomponent.currentController.select(oRanges)
End Sub
'定位公式单元格(公式错误、数字值、字符值)
Sub location_Formula
oDoc = ThisComponent
oController = oDoc.getCurrentController
oSheet = oController.activeSheet
oSel = oDoc.getCurrentSelection()
REM 检测多重选择区域
If not oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
MsgBox "mulit selct"
Exit sub
End If
'oFilter = oSel.queryFormulaCells(com.sun.star.sheet.FormulaResult.ERROR) 'STRING VALUE
'oFilter = oSel.queryFormulaCells(com.sun.star.sheet.FormulaResult.STRING)
oFilter = oSel.queryFormulaCells(com.sun.star.sheet.FormulaResult.VALUE)
thiscomponent.currentController.select(oFilter)
End Sub
'定位空单元格
Sub location_Empty
oDoc = ThisComponent
oController = oDoc.getCurrentController
oSheet = oController.activeSheet
oSel = oDoc.getCurrentSelection()
REM 检测多重选择区域
If not oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
MsgBox "mulit selct"
Exit sub
End If
oFilter = oSel.queryEmptyCells
thiscomponent.currentController.select(oFilter)
End Sub
REM 定位公式引用和从属,用“工具--追踪”更好。
REM 追踪引用Shift+F9, 追踪从属Shift+F5
REM queryDependents ( bRecursive as boolean ) AS com.sun.star.sheet.XSheetCellRanges com.sun.star.sheet.XFormulaQuery
REM queryPrecedents ( bRecursive as boolean ) AS com.sun.star.sheet.XSheetCellRanges com.sun.star.sheet.XFormulaQuery
REM 下面这个好像不须用了
REM queryIntersection ( aRange as com.sun.star.table.CellRangeAddress ) AS com.sun.star.sheet.XSheetCellRanges com.sun.star.sheet.XCellRangesQuery
|