D7net
Home
Console
Upload
information
Create File
Create Folder
About
Tools
:
/
lib
/
libreoffice
/
share
/
basic
/
Template
/
Filename :
Autotext.xba
back
Copy
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!-- * This file is part of the LibreOffice project. * * This Source Code Form is subject to the terms of the Mozilla Public * License, v. 2.0. If a copy of the MPL was not distributed with this * file, You can obtain one at http://mozilla.org/MPL/2.0/. * * This file incorporates work covered by the following license notice: * * Licensed to the Apache Software Foundation (ASF) under one or more * contributor license agreements. See the NOTICE file distributed * with this work for additional information regarding copyright * ownership. The ASF licenses this file to you under the Apache * License, Version 2.0 (the "License"); you may not use this file * except in compliance with the License. You may obtain a copy of * the License at http://www.apache.org/licenses/LICENSE-2.0 . --> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Autotext" script:language="StarBasic">Option Explicit Public UserfieldDataType(14) as String Public oDocAuto as Object Public BulletList(7) as Integer Public sTextFieldNotDefined as String Public sGeneralError as String Sub Main() Dim oCursor as Object Dim oStyles as Object Dim oSearchDesc as Object Dim oFoundall as Object Dim oFound as Object Dim i as Integer Dim sFoundString as String Dim sFoundContent as String Dim FieldStringThere as String Dim ULStringThere as String Dim PHStringThere as String On Local Error Goto GENERALERROR ' Initialization... BasicLibraries.LoadLibrary("Tools") If InitResources("'Template'") Then sGeneralError = GetResText("CorrespondenceMsgError") sTextFieldNotDefined = GetResText("TextField") End If UserfieldDatatype(0) = "COMPANY" UserfieldDatatype(1) = "FIRSTNAME" UserfieldDatatype(2) = "NAME" UserfieldDatatype(3) = "SHORTCUT" UserfieldDatatype(4) = "STREET" UserfieldDatatype(5) = "COUNTRY" UserfieldDatatype(6) = "ZIP" UserfieldDatatype(7) = "CITY" UserfieldDatatype(8) = "TITLE" UserfieldDatatype(9) = "POSITION" UserfieldDatatype(10) = "PHONE_PRIVATE" UserfieldDatatype(11) = "PHONE_COMPANY" UserfieldDatatype(12) = "FAX" UserfieldDatatype(13) = "EMAIL" UserfieldDatatype(14) = "STATE" BulletList(0) = 149 BulletList(1) = 34 BulletList(2) = 65 BulletList(3) = 61 BulletList(4) = 49 BulletList(5) = 47 BulletList(6) = 79 BulletList(7) = 58 oDocAuto = ThisComponent oStyles = oDocAuto.Stylefamilies.GetByName("NumberingStyles") ' Prepare the Search-Descriptor oSearchDesc = oDocAuto.createsearchDescriptor() oSearchDesc.SearchRegularExpression = True oSearchDesc.SearchWords = True oSearchDesc.SearchString = "<[^>]+>" oFoundall = oDocAuto.FindAll(oSearchDesc) 'Loop over the foundings For i = 0 To oFoundAll.Count - 1 oFound = oFoundAll.GetByIndex(i) sFoundString = oFound.String 'Extract the string inside the brackets sFoundContent = FindPartString(sFoundString,"<",">",1) sFoundContent = LTrim(sFoundContent) ' Define the Cursor and place it on the founding oCursor = oFound.Text.CreateTextCursorbyRange(oFound) ' Find out, which object is to be created... FieldStringThere = Instr(1,sFoundContent,"Field") ULStringThere = Instr(1,sFoundContent,"UL") PHStringThere = Instr(1,sFoundContent,"Placeholder") If FieldStringThere = 1 Then CreateUserDatafield(oCursor, sFoundContent) ElseIf ULStringThere = 1 Then CreateBullet(oCursor, oStyles) ElseIf PHStringThere = 1 Then CreatePlaceholder(oCursor, sFoundContent) End If Next i GENERALERROR: If Err <> 0 Then Msgbox(sGeneralError,16, GetProductName()) Resume LETSGO End If LETSGO: End Sub ' creates a User - datafield out of a string with the following structure ' "<field:Company>" Sub CreateUserDatafield(oCursor, sFoundContent as String) Dim MaxIndex as Integer Dim sFoundList(3) Dim oUserfield as Object Dim UserInfo as String Dim UserIndex as Integer oUserfield = oDocAuto.CreateInstance("com.sun.star.text.TextField.ExtendedUser") sFoundList() = ArrayoutofString(sFoundContent,":",MaxIndex) UserInfo = UCase(LTrim(sFoundList(1))) UserIndex = IndexInArray(UserInfo, UserfieldDatatype()) If UserIndex <> -1 Then oUserField.UserDatatype = UserIndex oCursor.Text.InsertTextContent(oCursor,oUserField,True) oUserField.IsFixed = True Else Msgbox(UserInfo &": " & sTextFieldNotDefined,16, GetProductName()) End If End Sub ' Creates a Bullet by setting a soft Formatation on the first unsorted List-Templates with a defined ' Bullet Id Sub CreateBullet(oCursor, oStyles as Object) Dim n, m, s as Integer Dim StyleSet as Boolean Dim ostyle as Object Dim StyleName as String Dim alevel() StyleSet = False For s = 0 To Ubound(BulletList()) For n = 0 To oStyles.Count - 1 ostyle = oStyles.getbyindex(n) StyleName = oStyle.Name alevel() = ostyle.NumberingRules.getbyindex(0) ' The properties of the style are stored in a Name-Value-Array() For m = 0 to Ubound(alevel()) ' Set the first Numbering template without a bulletID If (aLevel(m).Name = "BulletId") Then If alevel(m).Value = BulletList(s) Then oCursor.NumberingStyle = StyleName oCursor.SetString("") exit Sub End if End If Next m Next n Next s If Not StyleSet Then ' The Template with the demanded BulletID is not available, so take the first style in the sequence ' that has a defined Bullet ID oCursor.NumberingStyleName = oStyles.GetByIndex(5).Name oCursor.SetString("") End If End Sub ' Creates a placeholder out of a string with the following structure: '<placeholder:Showtext:Helptext> Sub CreatePlaceholder(oCursor as Object, sFoundContent as String) Dim oPlaceholder as Object Dim MaxIndex as Integer Dim sFoundList(3) oPlaceholder = oDocAuto.CreateInstance("com.sun.star.text.TextField.JumpEdit") sFoundList() = ArrayoutofString(sFoundContent, ":" & chr(34),MaxIndex) ' Delete The Double-quotes oPlaceholder.Hint = DeleteStr(sFoundList(2),chr(34)) oPlaceholder.placeholder = DeleteStr(sFoundList(1),chr(34)) oCursor.Text.InsertTextContent(oCursor,oPlaceholder,True) End Sub </script:module>