LibreOffice 宏

LibreOffice 宏

API 网站：https://api.libreoffice.org/
教程网站：https://www.pitonyak.org/book/

下面的宏可以在 LibreOffice 中实现文档着色：

' 功能：给选中的文本统一字体，添加灰色段落背景
Sub A01_CodeBlock
	dim document   as object
	dim dispatcher as object
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	rem ----------------------------------------------------------------------
	dim args0(0) as new com.sun.star.beans.PropertyValue
	dim args1(1) as new com.sun.star.beans.PropertyValue
	dim args2(2) as new com.sun.star.beans.PropertyValue
	dim args4(4) as new com.sun.star.beans.PropertyValue
	rem ----------------------------------------------------------------------
	args4(0).Name = "CharFontName.StyleName"
	args4(0).Value = ""
	args4(1).Name = "CharFontName.Pitch"
	args4(1).Value = 2
	args4(2).Name = "CharFontName.CharSet"
	args4(2).Value = 0
	args4(3).Name = "CharFontName.Family"
	args4(3).Value = 0
	args4(4).Name = "CharFontName.FamilyName"
	args4(4).Value = "AR PL UKai CN"
	dispatcher.executeDispatch(document, ".uno:CharFontName", "", 0, args4())
	rem ----------------------------------------------------------------------
	args2(0).Name = "FontHeight.Height"
	args2(0).Value = 12
	args2(1).Name = "FontHeight.Prop"
	args2(1).Value = 100
	args2(2).Name = "FontHeight.Diff"
	args2(2).Value = 0
	dispatcher.executeDispatch(document, ".uno:FontHeight", "", 0, args2())
	rem ----------------------------------------------------------------------
	args0(0).Name = "BackColor"
	args0(0).Value = -1
	dispatcher.executeDispatch(document, ".uno:BackColor", "", 0, args0())
	rem ----------------------------------------------------------------------
	args0(0).Name = "BackgroundColor"
	args0(0).Value = &HEEEEEE
	dispatcher.executeDispatch(document, ".uno:BackgroundColor", "", 0, args0())
	rem ----------------------------------------------------------------------
	args4(0).Name = "TopBottomMargin.TopMargin"
	args4(0).Value = 0
	args4(1).Name = "TopBottomMargin.BottomMargin"
	args4(1).Value = 0
	args4(2).Name = "TopBottomMargin.ContextMargin"
	args4(2).Value = false
	args4(3).Name = "TopBottomMargin.TopRelMargin"
	args4(3).Value = 100
	args4(4).Name = "TopBottomMargin.BottomRelMargin"
	args4(4).Value = 100
	dispatcher.executeDispatch(document, ".uno:TopBottomMargin", "", 0, args4())
	rem ----------------------------------------------------------------------
	args1(0).Name = "LineSpacing.Mode"
	args1(0).Value = 0
	args1(1).Name = "LineSpacing.Height"
	args1(1).Value = 100
	dispatcher.executeDispatch(document, ".uno:LineSpacing", "", 0, args1())
End Sub

' 功能：给文档中的拼音 [*] 和注释 {*} 添加颜色。
' 　　　可用类似的方法实现代码着色。
Sub A02_PinYinHighlight
  Dim aReplaceArgs(0) as new com.sun.star.beans.PropertyValue
  ' 恢复全文默认颜色
  aReplaceArgs(0).Name = "CharColor"
  aReplaceArgs(0).Value = &H000000
  ReplaceString(ThisComponent, ".+", "$0", aReplaceArgs)
  ' 中括号中的拼音设置为蓝色
  aReplaceArgs(0).Name = "CharColor"
  aReplaceArgs(0).Value = &H3465A4
  ReplaceString(ThisComponent, "\[.+?\]", "$0", aReplaceArgs)
  ' 花括号中的注释设置为红色
  aReplaceArgs(0).Name = "CharColor"
  aReplaceArgs(0).Value = &HFF0000
  ReplaceString(ThisComponent, "\{.+?\}", "$0", aReplaceArgs)
End Sub

' 功能：删除行尾空白
Sub A03_ClearTailingSpace
  ReplaceString(ThisComponent, "[ \t]+$", "", Nothing)
End Sub

' 功能：Tab 转空格
Sub A04_Tab2Space
  ReplaceString(ThisComponent, "\t", "    ", Nothing)
End Sub

' 功能：在 oContainer 中搜索 sSearchString，并替换为 sReplaceString，
' 　　　同时指定替换时的属性 aReplaceArgs，支持正则表达式
' 示例：将文档中的 a 替换为红色加粗的 b
' ------------------------------
' 创建一个属性数组，包含两个元素
' Dim aReplaceArgs(1) as new com.sun.star.beans.PropertyValue
' 属性名为 CharColor，属性值为 &HFF0000
' aReplaceArgs(0).Name = "CharColor"
' aReplaceArgs(0).Value = &HFF0000
' 属性名为 CharWeight，属性值为 BOLD，即 150.0
' aReplaceArgs(1).Name = "CharWeight"
' aReplaceArgs(1).Value = com.sun.star.awt.FontWeight.BOLD
' 执行替换操作，替换范围为整个文档
' ReplaceString(ThisComponent, "a", "b", aReplaceArgs)
' ------------------------------
Sub ReplaceString(oContainer as Object, sSearchString, sReplaceString as String, aReplaceArgs as Object)
	oReplaceDesc = oContainer.createReplaceDescriptor()
	oReplaceDesc.SearchCaseSensitive = True
	oReplaceDesc.SearchRegularExpression = True
	oReplaceDesc.Searchstring = sSearchString
	oReplaceDesc.ReplaceString = sReplaceString
    if not (aReplaceArgs is Nothing) then
        oReplaceDesc.setReplaceAttributes(aReplaceArgs)
    end if
	oReplCount = oContainer.ReplaceAll(oReplaceDesc)
End Sub

' 功能：列出对象拥有的所有属性
' 示例：列出 ThisComponent 的所有属性
' ------------------------------
' ListProperties(ThisComponent)
' ------------------------------
' 示例：列出光标处文本的所有属性
' ------------------------------
' oCursor = ThisComponent.currentController.getViewCursor()
' ListProperties(oCursor)
' ------------------------------
Sub ListProperties(oObject as Object)
  aProperties = oObject.getPropertySetInfo().getProperties()
  Dim sResult as String
  For Index = lbound(aProperties) to ubound(aProperties)
    sResult = sResult + Chr(10) + oObject.getPropertySetInfo().getProperties()(Index).Name
  Next
  msgbox(sResult)
End Sub