1*b1cdbd2cSJim Jagielski<?xml version="1.0" encoding="UTF-8"?> 2*b1cdbd2cSJim Jagielski<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 3*b1cdbd2cSJim Jagielski<!--*********************************************************** 4*b1cdbd2cSJim Jagielski * 5*b1cdbd2cSJim Jagielski * Licensed to the Apache Software Foundation (ASF) under one 6*b1cdbd2cSJim Jagielski * or more contributor license agreements. See the NOTICE file 7*b1cdbd2cSJim Jagielski * distributed with this work for additional information 8*b1cdbd2cSJim Jagielski * regarding copyright ownership. The ASF licenses this file 9*b1cdbd2cSJim Jagielski * to you under the Apache License, Version 2.0 (the 10*b1cdbd2cSJim Jagielski * "License"); you may not use this file except in compliance 11*b1cdbd2cSJim Jagielski * with the License. You may obtain a copy of the License at 12*b1cdbd2cSJim Jagielski * 13*b1cdbd2cSJim Jagielski * http://www.apache.org/licenses/LICENSE-2.0 14*b1cdbd2cSJim Jagielski * 15*b1cdbd2cSJim Jagielski * Unless required by applicable law or agreed to in writing, 16*b1cdbd2cSJim Jagielski * software distributed under the License is distributed on an 17*b1cdbd2cSJim Jagielski * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 18*b1cdbd2cSJim Jagielski * KIND, either express or implied. See the License for the 19*b1cdbd2cSJim Jagielski * specific language governing permissions and limitations 20*b1cdbd2cSJim Jagielski * under the License. 21*b1cdbd2cSJim Jagielski * 22*b1cdbd2cSJim Jagielski ***********************************************************--> 23*b1cdbd2cSJim Jagielski<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Misc" script:language="StarBasic">REM ***** BASIC ***** 24*b1cdbd2cSJim Jagielski 25*b1cdbd2cSJim JagielskiConst SBSHARE = 0 26*b1cdbd2cSJim JagielskiConst SBUSER = 1 27*b1cdbd2cSJim JagielskiDim Taskindex as Integer 28*b1cdbd2cSJim JagielskiDim oResSrv as Object 29*b1cdbd2cSJim Jagielski 30*b1cdbd2cSJim JagielskiSub Main() 31*b1cdbd2cSJim JagielskiDim PropList(3,1)' as String 32*b1cdbd2cSJim Jagielski PropList(0,0) = "URL" 33*b1cdbd2cSJim Jagielski PropList(0,1) = "sdbc:odbc:Erica_Test_Unicode" 34*b1cdbd2cSJim Jagielski PropList(1,0) = "User" 35*b1cdbd2cSJim Jagielski PropList(1,1) = "extra" 36*b1cdbd2cSJim Jagielski PropList(2,0) = "Password" 37*b1cdbd2cSJim Jagielski PropList(2,1) = "extra" 38*b1cdbd2cSJim Jagielski PropList(3,0) = "IsPasswordRequired" 39*b1cdbd2cSJim Jagielski PropList(3,1) = True 40*b1cdbd2cSJim JagielskiEnd Sub 41*b1cdbd2cSJim Jagielski 42*b1cdbd2cSJim Jagielski 43*b1cdbd2cSJim JagielskiFunction RegisterNewDataSource(DSName as String, PropertyList(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue) 44*b1cdbd2cSJim JagielskiDim oDataSource as Object 45*b1cdbd2cSJim JagielskiDim oDBContext as Object 46*b1cdbd2cSJim JagielskiDim oPropInfo as Object 47*b1cdbd2cSJim JagielskiDim i as Integer 48*b1cdbd2cSJim Jagielski oDBContext = createUnoService("com.sun.star.sdb.DatabaseContext") 49*b1cdbd2cSJim Jagielski oDataSource = createUnoService("com.sun.star.sdb.DataSource") 50*b1cdbd2cSJim Jagielski For i = 0 To Ubound(PropertyList(), 1) 51*b1cdbd2cSJim Jagielski sPropName = PropertyList(i,0) 52*b1cdbd2cSJim Jagielski sPropValue = PropertyList(i,1) 53*b1cdbd2cSJim Jagielski oDataSource.SetPropertyValue(sPropName,sPropValue) 54*b1cdbd2cSJim Jagielski Next i 55*b1cdbd2cSJim Jagielski If Not IsMissing(DriverProperties()) Then 56*b1cdbd2cSJim Jagielski oDataSource.Info() = DriverProperties() 57*b1cdbd2cSJim Jagielski End If 58*b1cdbd2cSJim Jagielski oDBContext.RegisterObject(DSName, oDataSource) 59*b1cdbd2cSJim Jagielski RegisterNewDataSource () = oDataSource 60*b1cdbd2cSJim JagielskiEnd Function 61*b1cdbd2cSJim Jagielski 62*b1cdbd2cSJim Jagielski 63*b1cdbd2cSJim Jagielski' Connects to a registered Database 64*b1cdbd2cSJim JagielskiFunction ConnecttoDatabase(DSName as String, UserID as String, Password as String, Optional Propertylist(), Optional DriverProperties() as New com.sun.star.beans.PropertyValue) 65*b1cdbd2cSJim JagielskiDim oDBContext as Object 66*b1cdbd2cSJim JagielskiDim oDBSource as Object 67*b1cdbd2cSJim Jagielski' On Local Error Goto NOCONNECTION 68*b1cdbd2cSJim Jagielski oDBContext = CreateUnoService("com.sun.star.sdb.DatabaseContext") 69*b1cdbd2cSJim Jagielski If oDBContext.HasbyName(DSName) Then 70*b1cdbd2cSJim Jagielski oDBSource = oDBContext.GetByName(DSName) 71*b1cdbd2cSJim Jagielski ConnectToDatabase = oDBSource.GetConnection(UserID, Password) 72*b1cdbd2cSJim Jagielski Else 73*b1cdbd2cSJim Jagielski If Not IsMissing(Namelist()) Then 74*b1cdbd2cSJim Jagielski If Not IsMissing(DriverProperties()) Then 75*b1cdbd2cSJim Jagielski RegisterNewDataSource(DSName, PropertyList(), DriverProperties()) 76*b1cdbd2cSJim Jagielski Else 77*b1cdbd2cSJim Jagielski RegisterNewDataSource(DSName, PropertyList()) 78*b1cdbd2cSJim Jagielski End If 79*b1cdbd2cSJim Jagielski oDBSource = oDBContext.GetByName(DSName) 80*b1cdbd2cSJim Jagielski ConnectToDatabase = oDBSource.GetConnection(UserID, Password) 81*b1cdbd2cSJim Jagielski Else 82*b1cdbd2cSJim Jagielski Msgbox("DataSource " & DSName & " is not registered" , 16, GetProductname()) 83*b1cdbd2cSJim Jagielski ConnectToDatabase() = NULL 84*b1cdbd2cSJim Jagielski End If 85*b1cdbd2cSJim Jagielski End If 86*b1cdbd2cSJim JagielskiNOCONNECTION: 87*b1cdbd2cSJim Jagielski If Err <> 0 Then 88*b1cdbd2cSJim Jagielski Msgbox(Error$, 16, GetProductName()) 89*b1cdbd2cSJim Jagielski Resume LEAVESUB 90*b1cdbd2cSJim Jagielski LEAVESUB: 91*b1cdbd2cSJim Jagielski End If 92*b1cdbd2cSJim JagielskiEnd Function 93*b1cdbd2cSJim Jagielski 94*b1cdbd2cSJim Jagielski 95*b1cdbd2cSJim JagielskiFunction GetStarOfficeLocale() as New com.sun.star.lang.Locale 96*b1cdbd2cSJim JagielskiDim aLocLocale As New com.sun.star.lang.Locale 97*b1cdbd2cSJim JagielskiDim sLocale as String 98*b1cdbd2cSJim JagielskiDim sLocaleList(1) 99*b1cdbd2cSJim JagielskiDim oMasterKey 100*b1cdbd2cSJim Jagielski oMasterKey = GetRegistryKeyContent("org.openoffice.Setup/L10N/") 101*b1cdbd2cSJim Jagielski sLocale = oMasterKey.getByName("ooLocale") 102*b1cdbd2cSJim Jagielski sLocaleList() = ArrayoutofString(sLocale, "-") 103*b1cdbd2cSJim Jagielski aLocLocale.Language = sLocaleList(0) 104*b1cdbd2cSJim Jagielski If Ubound(sLocaleList()) > 0 Then 105*b1cdbd2cSJim Jagielski aLocLocale.Country = sLocaleList(1) 106*b1cdbd2cSJim Jagielski End If 107*b1cdbd2cSJim Jagielski GetStarOfficeLocale() = aLocLocale 108*b1cdbd2cSJim JagielskiEnd Function 109*b1cdbd2cSJim Jagielski 110*b1cdbd2cSJim Jagielski 111*b1cdbd2cSJim JagielskiFunction GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) 112*b1cdbd2cSJim JagielskiDim oConfigProvider as Object 113*b1cdbd2cSJim JagielskiDim aNodePath(0) as new com.sun.star.beans.PropertyValue 114*b1cdbd2cSJim Jagielski oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider") 115*b1cdbd2cSJim Jagielski aNodePath(0).Name = "nodepath" 116*b1cdbd2cSJim Jagielski aNodePath(0).Value = sKeyName 117*b1cdbd2cSJim Jagielski If IsMissing(bForUpdate) Then 118*b1cdbd2cSJim Jagielski GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) 119*b1cdbd2cSJim Jagielski Else 120*b1cdbd2cSJim Jagielski If bForUpdate Then 121*b1cdbd2cSJim Jagielski GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess", aNodePath()) 122*b1cdbd2cSJim Jagielski Else 123*b1cdbd2cSJim Jagielski GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", aNodePath()) 124*b1cdbd2cSJim Jagielski End If 125*b1cdbd2cSJim Jagielski End If 126*b1cdbd2cSJim JagielskiEnd Function 127*b1cdbd2cSJim Jagielski 128*b1cdbd2cSJim Jagielski 129*b1cdbd2cSJim JagielskiFunction GetProductname() as String 130*b1cdbd2cSJim JagielskiDim oProdNameAccess as Object 131*b1cdbd2cSJim JagielskiDim sVersion as String 132*b1cdbd2cSJim JagielskiDim sProdName as String 133*b1cdbd2cSJim Jagielski oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product") 134*b1cdbd2cSJim Jagielski sProdName = oProdNameAccess.getByName("ooName") 135*b1cdbd2cSJim Jagielski sVersion = oProdNameAccess.getByName("ooSetupVersion") 136*b1cdbd2cSJim Jagielski GetProductName = sProdName & sVersion 137*b1cdbd2cSJim JagielskiEnd Function 138*b1cdbd2cSJim Jagielski 139*b1cdbd2cSJim Jagielski 140*b1cdbd2cSJim Jagielski' Opens a Document, checks beforehand, wether it has to be loaded 141*b1cdbd2cSJim Jagielski' or wether it is already on the desktop. 142*b1cdbd2cSJim Jagielski' If the parameter bDisposable is set to False then then returned document 143*b1cdbd2cSJim Jagielski' should not be disposed afterwards, because it is already opened. 144*b1cdbd2cSJim JagielskiFunction OpenDocument(DocPath as String, Args(), Optional bDisposable as Boolean) 145*b1cdbd2cSJim JagielskiDim oComponents as Object 146*b1cdbd2cSJim JagielskiDim oComponent as Object 147*b1cdbd2cSJim Jagielski ' Search if one of the active Components ist the one that you search for 148*b1cdbd2cSJim Jagielski oComponents = StarDesktop.Components.CreateEnumeration 149*b1cdbd2cSJim Jagielski While oComponents.HasmoreElements 150*b1cdbd2cSJim Jagielski oComponent = oComponents.NextElement 151*b1cdbd2cSJim Jagielski If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then 152*b1cdbd2cSJim Jagielski If UCase(oComponent.URL) = UCase(DocPath) then 153*b1cdbd2cSJim Jagielski OpenDocument() = oComponent 154*b1cdbd2cSJim Jagielski If Not IsMissing(bDisposable) Then 155*b1cdbd2cSJim Jagielski bDisposable = False 156*b1cdbd2cSJim Jagielski End If 157*b1cdbd2cSJim Jagielski Exit Function 158*b1cdbd2cSJim Jagielski End If 159*b1cdbd2cSJim Jagielski End If 160*b1cdbd2cSJim Jagielski Wend 161*b1cdbd2cSJim Jagielski If Not IsMissing(bDisposable) Then 162*b1cdbd2cSJim Jagielski bDisposable = True 163*b1cdbd2cSJim Jagielski End If 164*b1cdbd2cSJim Jagielski OpenDocument() = StarDesktop.LoadComponentFromURL(DocPath,"_default",0,Args()) 165*b1cdbd2cSJim JagielskiEnd Function 166*b1cdbd2cSJim Jagielski 167*b1cdbd2cSJim Jagielski 168*b1cdbd2cSJim JagielskiFunction TaskonDesktop(DocPath as String) as Boolean 169*b1cdbd2cSJim JagielskiDim oComponents as Object 170*b1cdbd2cSJim JagielskiDim oComponent as Object 171*b1cdbd2cSJim Jagielski ' Search if one of the active Components ist the one that you search for 172*b1cdbd2cSJim Jagielski oComponents = StarDesktop.Components.CreateEnumeration 173*b1cdbd2cSJim Jagielski While oComponents.HasmoreElements 174*b1cdbd2cSJim Jagielski oComponent = oComponents.NextElement 175*b1cdbd2cSJim Jagielski If hasUnoInterfaces(oComponent,"com.sun.star.frame.XModel") then 176*b1cdbd2cSJim Jagielski If UCase(oComponent.URL) = UCase(DocPath) then 177*b1cdbd2cSJim Jagielski TaskonDesktop = True 178*b1cdbd2cSJim Jagielski Exit Function 179*b1cdbd2cSJim Jagielski End If 180*b1cdbd2cSJim Jagielski End If 181*b1cdbd2cSJim Jagielski Wend 182*b1cdbd2cSJim Jagielski TaskonDesktop = False 183*b1cdbd2cSJim JagielskiEnd Function 184*b1cdbd2cSJim Jagielski 185*b1cdbd2cSJim Jagielski 186*b1cdbd2cSJim Jagielski' Retrieves a FileName out of a StarOffice-Document 187*b1cdbd2cSJim JagielskiFunction RetrieveFileName(LocDoc as Object) 188*b1cdbd2cSJim JagielskiDim LocURL as String 189*b1cdbd2cSJim JagielskiDim LocURLArray() as String 190*b1cdbd2cSJim JagielskiDim MaxArrIndex as integer 191*b1cdbd2cSJim Jagielski 192*b1cdbd2cSJim Jagielski LocURL = LocDoc.Url 193*b1cdbd2cSJim Jagielski LocURLArray() = ArrayoutofString(LocURL,"/",MaxArrIndex) 194*b1cdbd2cSJim Jagielski RetrieveFileName = LocURLArray(MaxArrIndex) 195*b1cdbd2cSJim JagielskiEnd Function 196*b1cdbd2cSJim Jagielski 197*b1cdbd2cSJim Jagielski 198*b1cdbd2cSJim Jagielski' Gets a special configured PathSetting 199*b1cdbd2cSJim JagielskiFunction GetPathSettings(sPathType as String, Optional bshowall as Boolean, Optional ListIndex as integer) as String 200*b1cdbd2cSJim JagielskiDim oSettings, oPathSettings as Object 201*b1cdbd2cSJim JagielskiDim sPath as String 202*b1cdbd2cSJim JagielskiDim PathList() as String 203*b1cdbd2cSJim JagielskiDim MaxIndex as Integer 204*b1cdbd2cSJim JagielskiDim oPS as Object 205*b1cdbd2cSJim Jagielski 206*b1cdbd2cSJim Jagielski oPS = createUnoService("com.sun.star.util.PathSettings") 207*b1cdbd2cSJim Jagielski 208*b1cdbd2cSJim Jagielski If Not IsMissing(bShowall) Then 209*b1cdbd2cSJim Jagielski If bShowAll Then 210*b1cdbd2cSJim Jagielski ShowPropertyValues(oPS) 211*b1cdbd2cSJim Jagielski Exit Function 212*b1cdbd2cSJim Jagielski End If 213*b1cdbd2cSJim Jagielski End If 214*b1cdbd2cSJim Jagielski sPath = oPS.getPropertyValue(sPathType) 215*b1cdbd2cSJim Jagielski If Not IsMissing(ListIndex) Then 216*b1cdbd2cSJim Jagielski ' Share and User-Directory 217*b1cdbd2cSJim Jagielski If Instr(1,sPath,";") <> 0 Then 218*b1cdbd2cSJim Jagielski PathList = ArrayoutofString(sPath,";", MaxIndex) 219*b1cdbd2cSJim Jagielski If ListIndex <= MaxIndex Then 220*b1cdbd2cSJim Jagielski sPath = PathList(ListIndex) 221*b1cdbd2cSJim Jagielski Else 222*b1cdbd2cSJim Jagielski Msgbox("String Cannot be analyzed!" & sPath , 16, GetProductName()) 223*b1cdbd2cSJim Jagielski End If 224*b1cdbd2cSJim Jagielski End If 225*b1cdbd2cSJim Jagielski End If 226*b1cdbd2cSJim Jagielski If Instr(1, sPath, ";") = 0 Then 227*b1cdbd2cSJim Jagielski GetPathSettings = ConvertToUrl(sPath) 228*b1cdbd2cSJim Jagielski Else 229*b1cdbd2cSJim Jagielski GetPathSettings = sPath 230*b1cdbd2cSJim Jagielski End If 231*b1cdbd2cSJim Jagielski 232*b1cdbd2cSJim JagielskiEnd Function 233*b1cdbd2cSJim Jagielski 234*b1cdbd2cSJim Jagielski 235*b1cdbd2cSJim Jagielski 236*b1cdbd2cSJim Jagielski' Gets the fully qualified path to a subdirectory of the 237*b1cdbd2cSJim Jagielski' Template Directory, e. g. with the parameter "wizard/bitmap" 238*b1cdbd2cSJim Jagielski' The parameter must be passed over in Url-scription 239*b1cdbd2cSJim Jagielski' The return-Value is in Urlscription 240*b1cdbd2cSJim JagielskiFunction GetOfficeSubPath(sOfficePath as String, ByVal sSubDir as String) 241*b1cdbd2cSJim JagielskiDim sOfficeString as String 242*b1cdbd2cSJim JagielskiDim sOfficeList() as String 243*b1cdbd2cSJim JagielskiDim sOfficeDir as String 244*b1cdbd2cSJim JagielskiDim sBigDir as String 245*b1cdbd2cSJim JagielskiDim i as Integer 246*b1cdbd2cSJim JagielskiDim MaxIndex as Integer 247*b1cdbd2cSJim JagielskiDim oUcb as Object 248*b1cdbd2cSJim Jagielski oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") 249*b1cdbd2cSJim Jagielski sOfficeString = GetPathSettings(sOfficePath) 250*b1cdbd2cSJim Jagielski If Right(sSubDir,1) <> "/" Then 251*b1cdbd2cSJim Jagielski sSubDir = sSubDir & "/" 252*b1cdbd2cSJim Jagielski End If 253*b1cdbd2cSJim Jagielski sOfficeList() = ArrayoutofString(sOfficeString,";", MaxIndex) 254*b1cdbd2cSJim Jagielski For i = 0 To MaxIndex 255*b1cdbd2cSJim Jagielski sOfficeDir = ConvertToUrl(sOfficeList(i)) 256*b1cdbd2cSJim Jagielski If Right(sOfficeDir,1) <> "/" Then 257*b1cdbd2cSJim Jagielski sOfficeDir = sOfficeDir & "/" 258*b1cdbd2cSJim Jagielski End If 259*b1cdbd2cSJim Jagielski sBigDir = sOfficeDir & sSubDir 260*b1cdbd2cSJim Jagielski If oUcb.Exists(sBigDir) Then 261*b1cdbd2cSJim Jagielski GetOfficeSubPath() = sBigDir 262*b1cdbd2cSJim Jagielski Exit Function 263*b1cdbd2cSJim Jagielski End If 264*b1cdbd2cSJim Jagielski Next i 265*b1cdbd2cSJim Jagielski ShowNoOfficePathError() 266*b1cdbd2cSJim Jagielski GetOfficeSubPath = "" 267*b1cdbd2cSJim JagielskiEnd Function 268*b1cdbd2cSJim Jagielski 269*b1cdbd2cSJim Jagielski 270*b1cdbd2cSJim JagielskiSub ShowNoOfficePathError() 271*b1cdbd2cSJim JagielskiDim ProductName as String 272*b1cdbd2cSJim JagielskiDim sError as String 273*b1cdbd2cSJim JagielskiDim bResObjectexists as Boolean 274*b1cdbd2cSJim JagielskiDim oLocResSrv as Object 275*b1cdbd2cSJim Jagielski bResObjectexists = not IsNull(oResSrv) 276*b1cdbd2cSJim Jagielski If bResObjectexists Then 277*b1cdbd2cSJim Jagielski oLocResSrv = oResSrv 278*b1cdbd2cSJim Jagielski End If 279*b1cdbd2cSJim Jagielski If InitResources("Tools", "com") Then 280*b1cdbd2cSJim Jagielski ProductName = GetProductName() 281*b1cdbd2cSJim Jagielski sError = GetResText(1006) 282*b1cdbd2cSJim Jagielski sError = ReplaceString(sError, ProductName, "%PRODUCTNAME") 283*b1cdbd2cSJim Jagielski sError = ReplaceString(sError, chr(13), "<BR>") 284*b1cdbd2cSJim Jagielski MsgBox(sError, 16, ProductName) 285*b1cdbd2cSJim Jagielski End If 286*b1cdbd2cSJim Jagielski If bResObjectexists Then 287*b1cdbd2cSJim Jagielski oResSrv = oLocResSrv 288*b1cdbd2cSJim Jagielski End If 289*b1cdbd2cSJim Jagielski 290*b1cdbd2cSJim JagielskiEnd Sub 291*b1cdbd2cSJim Jagielski 292*b1cdbd2cSJim Jagielski 293*b1cdbd2cSJim JagielskiFunction InitResources(Description, ShortDescription as String) as boolean 294*b1cdbd2cSJim Jagielski On Error Goto ErrorOcurred 295*b1cdbd2cSJim Jagielski oResSrv = createUnoService( "com.sun.star.resource.VclStringResourceLoader" ) 296*b1cdbd2cSJim Jagielski If (IsNull(oResSrv)) then 297*b1cdbd2cSJim Jagielski InitResources = FALSE 298*b1cdbd2cSJim Jagielski MsgBox( Description & ": No resource loader found", 16, GetProductName()) 299*b1cdbd2cSJim Jagielski Else 300*b1cdbd2cSJim Jagielski InitResources = TRUE 301*b1cdbd2cSJim Jagielski oResSrv.FileName = ShortDescription 302*b1cdbd2cSJim Jagielski End If 303*b1cdbd2cSJim Jagielski Exit Function 304*b1cdbd2cSJim JagielskiErrorOcurred: 305*b1cdbd2cSJim Jagielski Dim nSolarVer 306*b1cdbd2cSJim Jagielski InitResources = FALSE 307*b1cdbd2cSJim Jagielski nSolarVer = GetSolarVersion() 308*b1cdbd2cSJim Jagielski MsgBox("Resource file missing (" & ShortDescription & trim(str(nSolarVer)) + "*.res)", 16, GetProductName()) 309*b1cdbd2cSJim Jagielski Resume CLERROR 310*b1cdbd2cSJim Jagielski CLERROR: 311*b1cdbd2cSJim JagielskiEnd Function 312*b1cdbd2cSJim Jagielski 313*b1cdbd2cSJim Jagielski 314*b1cdbd2cSJim JagielskiFunction GetResText( nID as integer ) As string 315*b1cdbd2cSJim Jagielski On Error Goto ErrorOcurred 316*b1cdbd2cSJim Jagielski If Not IsNull(oResSrv) Then 317*b1cdbd2cSJim Jagielski GetResText = oResSrv.getString( nID ) 318*b1cdbd2cSJim Jagielski Else 319*b1cdbd2cSJim Jagielski GetResText = "" 320*b1cdbd2cSJim Jagielski End If 321*b1cdbd2cSJim Jagielski Exit Function 322*b1cdbd2cSJim JagielskiErrorOcurred: 323*b1cdbd2cSJim Jagielski GetResText = "" 324*b1cdbd2cSJim Jagielski MsgBox("Resource with ID =" + str( nID ) + " not found!", 16, GetProductName()) 325*b1cdbd2cSJim Jagielski Resume CLERROR 326*b1cdbd2cSJim Jagielski CLERROR: 327*b1cdbd2cSJim JagielskiEnd Function 328*b1cdbd2cSJim Jagielski 329*b1cdbd2cSJim Jagielski 330*b1cdbd2cSJim JagielskiFunction CutPathView(sDocUrl as String, Optional PathLen as Integer) 331*b1cdbd2cSJim JagielskiDim sViewPath as String 332*b1cdbd2cSJim JagielskiDim FileName as String 333*b1cdbd2cSJim JagielskiDim iFileLen as Integer 334*b1cdbd2cSJim Jagielski sViewPath = ConvertfromURL(sDocURL) 335*b1cdbd2cSJim Jagielski iViewPathLen = Len(sViewPath) 336*b1cdbd2cSJim Jagielski If iViewPathLen > 60 Then 337*b1cdbd2cSJim Jagielski FileName = FileNameoutofPath(sViewPath, "/") 338*b1cdbd2cSJim Jagielski iFileLen = Len(FileName) 339*b1cdbd2cSJim Jagielski If iFileLen < 44 Then 340*b1cdbd2cSJim Jagielski sViewPath = Left(sViewPath,57-iFileLen-10) & "..." & Right(sViewPath,iFileLen + 10) 341*b1cdbd2cSJim Jagielski Else 342*b1cdbd2cSJim Jagielski sViewPath = Left(sViewPath,27) & " ... " & Right(sViewPath,28) 343*b1cdbd2cSJim Jagielski End If 344*b1cdbd2cSJim Jagielski End If 345*b1cdbd2cSJim Jagielski CutPathView = sViewPath 346*b1cdbd2cSJim JagielskiEnd Function 347*b1cdbd2cSJim Jagielski 348*b1cdbd2cSJim Jagielski 349*b1cdbd2cSJim Jagielski' Deletes the content of all cells that are softformatted according 350*b1cdbd2cSJim Jagielski' to the 'InputStyleName' 351*b1cdbd2cSJim JagielskiSub DeleteInputCells(oSheet as Object, InputStyleName as String) 352*b1cdbd2cSJim JagielskiDim oRanges as Object 353*b1cdbd2cSJim JagielskiDim oRange as Object 354*b1cdbd2cSJim Jagielski oRanges = oSheet.CellFormatRanges.createEnumeration 355*b1cdbd2cSJim Jagielski While oRanges.hasMoreElements 356*b1cdbd2cSJim Jagielski oRange = oRanges.NextElement 357*b1cdbd2cSJim Jagielski If Instr(1,oRange.CellStyle, InputStyleName) <> 0 Then 358*b1cdbd2cSJim Jagielski Call ReplaceRangeValues(oRange, "") 359*b1cdbd2cSJim Jagielski End If 360*b1cdbd2cSJim Jagielski Wend 361*b1cdbd2cSJim JagielskiEnd Sub 362*b1cdbd2cSJim Jagielski 363*b1cdbd2cSJim Jagielski 364*b1cdbd2cSJim Jagielski' Inserts a certain String to all cells of a Range that ist passed over 365*b1cdbd2cSJim Jagielski' either as an object or as the RangeName 366*b1cdbd2cSJim JagielskiSub ChangeValueofRange(oSheet as Object, Range, ReplaceValue, Optional StyleName as String) 367*b1cdbd2cSJim JagielskiDim oCellRange as Object 368*b1cdbd2cSJim Jagielski If Vartype(Range) = 8 Then 369*b1cdbd2cSJim Jagielski ' Get the Range out of the Rangename 370*b1cdbd2cSJim Jagielski oCellRange = oSheet.GetCellRangeByName(Range) 371*b1cdbd2cSJim Jagielski Else 372*b1cdbd2cSJim Jagielski ' The range is passed over as an object 373*b1cdbd2cSJim Jagielski Set oCellRange = Range 374*b1cdbd2cSJim Jagielski End If 375*b1cdbd2cSJim Jagielski If IsMissing(StyleName) Then 376*b1cdbd2cSJim Jagielski ReplaceRangeValues(oCellRange, ReplaceValue) 377*b1cdbd2cSJim Jagielski Else 378*b1cdbd2cSJim Jagielski If Instr(1,oCellRange.CellStyle,StyleName) Then 379*b1cdbd2cSJim Jagielski ReplaceRangeValues(oCellRange, ReplaceValue) 380*b1cdbd2cSJim Jagielski End If 381*b1cdbd2cSJim Jagielski End If 382*b1cdbd2cSJim JagielskiEnd Sub 383*b1cdbd2cSJim Jagielski 384*b1cdbd2cSJim Jagielski 385*b1cdbd2cSJim JagielskiSub ReplaceRangeValues(oRange as Object, ReplaceValue) 386*b1cdbd2cSJim JagielskiDim oRangeAddress as Object 387*b1cdbd2cSJim JagielskiDim ColCount as Integer 388*b1cdbd2cSJim JagielskiDim RowCount as Integer 389*b1cdbd2cSJim JagielskiDim i as Integer 390*b1cdbd2cSJim Jagielski oRangeAddress = oRange.RangeAddress 391*b1cdbd2cSJim Jagielski ColCount = oRangeAddress.EndColumn - oRangeAddress.StartColumn 392*b1cdbd2cSJim Jagielski RowCount = oRangeAddress.EndRow - oRangeAddress.StartRow 393*b1cdbd2cSJim Jagielski Dim FillArray(RowCount) as Variant 394*b1cdbd2cSJim Jagielski Dim sLine(ColCount) as Variant 395*b1cdbd2cSJim Jagielski For i = 0 To ColCount 396*b1cdbd2cSJim Jagielski sLine(i) = ReplaceValue 397*b1cdbd2cSJim Jagielski Next i 398*b1cdbd2cSJim Jagielski For i = 0 To RowCount 399*b1cdbd2cSJim Jagielski FillArray(i) = sLine() 400*b1cdbd2cSJim Jagielski Next i 401*b1cdbd2cSJim Jagielski oRange.DataArray = FillArray() 402*b1cdbd2cSJim JagielskiEnd Sub 403*b1cdbd2cSJim Jagielski 404*b1cdbd2cSJim Jagielski 405*b1cdbd2cSJim Jagielski' Returns the Value of the first cell of a Range 406*b1cdbd2cSJim JagielskiFunction GetValueofCellbyName(oSheet as Object, sCellName as String) 407*b1cdbd2cSJim JagielskiDim oCell as Object 408*b1cdbd2cSJim Jagielski oCell = GetCellByName(oSheet, sCellName) 409*b1cdbd2cSJim Jagielski GetValueofCellbyName = oCell.Value 410*b1cdbd2cSJim JagielskiEnd Function 411*b1cdbd2cSJim Jagielski 412*b1cdbd2cSJim Jagielski 413*b1cdbd2cSJim JagielskiFunction DuplicateRow(oSheet as Object, RangeName as String) 414*b1cdbd2cSJim JagielskiDim oRange as Object 415*b1cdbd2cSJim JagielskiDim oCell as Object 416*b1cdbd2cSJim JagielskiDim oCellAddress as New com.sun.star.table.CellAddress 417*b1cdbd2cSJim JagielskiDim oRangeAddress as New com.sun.star.table.CellRangeAddress 418*b1cdbd2cSJim Jagielski oRange = oSheet.GetCellRangeByName(RangeName) 419*b1cdbd2cSJim Jagielski oRangeAddress = oRange.RangeAddress 420*b1cdbd2cSJim Jagielski oCell = oSheet.GetCellByPosition(oRangeAddress.StartColumn,oRangeAddress.StartRow) 421*b1cdbd2cSJim Jagielski oCellAddress = oCell.CellAddress 422*b1cdbd2cSJim Jagielski oSheet.Rows.InsertByIndex(oCellAddress.Row,1) 423*b1cdbd2cSJim Jagielski oRangeAddress = oRange.RangeAddress 424*b1cdbd2cSJim Jagielski oSheet.CopyRange(oCellAddress, oRangeAddress) 425*b1cdbd2cSJim Jagielski DuplicateRow = oRangeAddress.StartRow-1 426*b1cdbd2cSJim JagielskiEnd Function 427*b1cdbd2cSJim Jagielski 428*b1cdbd2cSJim Jagielski 429*b1cdbd2cSJim Jagielski' Returns the String of the first cell of a Range 430*b1cdbd2cSJim JagielskiFunction GetStringofCellbyName(oSheet as Object, sCellName as String) 431*b1cdbd2cSJim JagielskiDim oCell as Object 432*b1cdbd2cSJim Jagielski oCell = GetCellByName(oSheet, sCellName) 433*b1cdbd2cSJim Jagielski GetStringofCellbyName = oCell.String 434*b1cdbd2cSJim JagielskiEnd Function 435*b1cdbd2cSJim Jagielski 436*b1cdbd2cSJim Jagielski 437*b1cdbd2cSJim Jagielski' Returns a named Cell 438*b1cdbd2cSJim JagielskiFunction GetCellByName(oSheet as Object, sCellName as String) as Object 439*b1cdbd2cSJim JagielskiDim oCellRange as Object 440*b1cdbd2cSJim JagielskiDim oCellAddress as Object 441*b1cdbd2cSJim Jagielski oCellRange = oSheet.GetCellRangeByName(sCellName) 442*b1cdbd2cSJim Jagielski oCellAddress = oCellRange.RangeAddress 443*b1cdbd2cSJim Jagielski GetCellByName = oSheet.GetCellByPosition(oCellAddress.StartColumn,oCellAddress.StartRow) 444*b1cdbd2cSJim JagielskiEnd Function 445*b1cdbd2cSJim Jagielski 446*b1cdbd2cSJim Jagielski 447*b1cdbd2cSJim Jagielski' Changes the numeric Value of a cell by transmitting the String of the numeric Value 448*b1cdbd2cSJim JagielskiSub ChangeCellValue(oCell as Object, ValueString as String) 449*b1cdbd2cSJim JagielskiDim CellValue 450*b1cdbd2cSJim Jagielski oCell.Formula = "=Value(" & """" & ValueString & """" & ")" 451*b1cdbd2cSJim Jagielski CellValue = oCell.Value 452*b1cdbd2cSJim Jagielski oCell.Formula = "" 453*b1cdbd2cSJim Jagielski oCell.Value = CellValue 454*b1cdbd2cSJim JagielskiEnd Sub 455*b1cdbd2cSJim Jagielski 456*b1cdbd2cSJim Jagielski 457*b1cdbd2cSJim JagielskiFunction GetDocumentType(oDocument) 458*b1cdbd2cSJim Jagielski On Local Error GoTo NODOCUMENTTYPE 459*b1cdbd2cSJim Jagielski' ShowSupportedServiceNames(oDocument) 460*b1cdbd2cSJim Jagielski If oDocument.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then 461*b1cdbd2cSJim Jagielski GetDocumentType() = "scalc" 462*b1cdbd2cSJim Jagielski ElseIf oDocument.SupportsService("com.sun.star.text.TextDocument") Then 463*b1cdbd2cSJim Jagielski GetDocumentType() = "swriter" 464*b1cdbd2cSJim Jagielski ElseIf oDocument.SupportsService("com.sun.star.drawing.DrawingDocument") Then 465*b1cdbd2cSJim Jagielski GetDocumentType() = "sdraw" 466*b1cdbd2cSJim Jagielski ElseIf oDocument.SupportsService("com.sun.star.presentation.PresentationDocument") Then 467*b1cdbd2cSJim Jagielski GetDocumentType() = "simpress" 468*b1cdbd2cSJim Jagielski ElseIf oDocument.SupportsService("com.sun.star.formula.FormulaProperties") Then 469*b1cdbd2cSJim Jagielski GetDocumentType() = "smath" 470*b1cdbd2cSJim Jagielski End If 471*b1cdbd2cSJim Jagielski NODOCUMENTTYPE: 472*b1cdbd2cSJim Jagielski If Err <> 0 Then 473*b1cdbd2cSJim Jagielski GetDocumentType = "" 474*b1cdbd2cSJim Jagielski Resume GOON 475*b1cdbd2cSJim Jagielski GOON: 476*b1cdbd2cSJim Jagielski End If 477*b1cdbd2cSJim JagielskiEnd Function 478*b1cdbd2cSJim Jagielski 479*b1cdbd2cSJim Jagielski 480*b1cdbd2cSJim JagielskiFunction GetNumberFormatType(oDocFormats, oFormatObject as Object) as Integer 481*b1cdbd2cSJim JagielskiDim ThisFormatKey as Long 482*b1cdbd2cSJim JagielskiDim oObjectFormat as Object 483*b1cdbd2cSJim Jagielski On Local Error Goto NOFORMAT 484*b1cdbd2cSJim Jagielski ThisFormatKey = oFormatObject.NumberFormat 485*b1cdbd2cSJim Jagielski oObjectFormat = oDocFormats.GetByKey(ThisFormatKey) 486*b1cdbd2cSJim Jagielski GetNumberFormatType = oObjectFormat.Type 487*b1cdbd2cSJim Jagielski NOFORMAT: 488*b1cdbd2cSJim Jagielski If Err <> 0 Then 489*b1cdbd2cSJim Jagielski Msgbox("Numberformat of Object is not available!", 16, GetProductName()) 490*b1cdbd2cSJim Jagielski GetNumberFormatType = 0 491*b1cdbd2cSJim Jagielski GOTO NOERROR 492*b1cdbd2cSJim Jagielski End If 493*b1cdbd2cSJim Jagielski NOERROR: 494*b1cdbd2cSJim Jagielski On Local Error Goto 0 495*b1cdbd2cSJim JagielskiEnd Function 496*b1cdbd2cSJim Jagielski 497*b1cdbd2cSJim Jagielski 498*b1cdbd2cSJim JagielskiSub ProtectSheets(Optional oSheets as Object) 499*b1cdbd2cSJim JagielskiDim i as Integer 500*b1cdbd2cSJim JagielskiDim oDocSheets as Object 501*b1cdbd2cSJim Jagielski If IsMissing(oSheets) Then 502*b1cdbd2cSJim Jagielski oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets 503*b1cdbd2cSJim Jagielski Else 504*b1cdbd2cSJim Jagielski Set oDocSheets = oSheets 505*b1cdbd2cSJim Jagielski End If 506*b1cdbd2cSJim Jagielski 507*b1cdbd2cSJim Jagielski For i = 0 To oDocSheets.Count-1 508*b1cdbd2cSJim Jagielski oDocSheets(i).Protect("") 509*b1cdbd2cSJim Jagielski Next i 510*b1cdbd2cSJim JagielskiEnd Sub 511*b1cdbd2cSJim Jagielski 512*b1cdbd2cSJim Jagielski 513*b1cdbd2cSJim JagielskiSub UnprotectSheets(Optional oSheets as Object) 514*b1cdbd2cSJim JagielskiDim i as Integer 515*b1cdbd2cSJim JagielskiDim oDocSheets as Object 516*b1cdbd2cSJim Jagielski If IsMissing(oSheets) Then 517*b1cdbd2cSJim Jagielski oDocSheets = StarDesktop.CurrentFrame.Controller.Model.Sheets 518*b1cdbd2cSJim Jagielski Else 519*b1cdbd2cSJim Jagielski Set oDocSheets = oSheets 520*b1cdbd2cSJim Jagielski End If 521*b1cdbd2cSJim Jagielski 522*b1cdbd2cSJim Jagielski For i = 0 To oDocSheets.Count-1 523*b1cdbd2cSJim Jagielski oDocSheets(i).Unprotect("") 524*b1cdbd2cSJim Jagielski Next i 525*b1cdbd2cSJim JagielskiEnd Sub 526*b1cdbd2cSJim Jagielski 527*b1cdbd2cSJim Jagielski 528*b1cdbd2cSJim JagielskiFunction GetRowIndex(oSheet as Object, RowName as String) 529*b1cdbd2cSJim JagielskiDim oRange as Object 530*b1cdbd2cSJim Jagielski oRange = oSheet.GetCellRangeByName(RowName) 531*b1cdbd2cSJim Jagielski GetRowIndex = oRange.RangeAddress.StartRow 532*b1cdbd2cSJim JagielskiEnd Function 533*b1cdbd2cSJim Jagielski 534*b1cdbd2cSJim Jagielski 535*b1cdbd2cSJim JagielskiFunction GetColumnIndex(oSheet as Object, ColName as String) 536*b1cdbd2cSJim JagielskiDim oRange as Object 537*b1cdbd2cSJim Jagielski oRange = oSheet.GetCellRangeByName(ColName) 538*b1cdbd2cSJim Jagielski GetColumnIndex = oRange.RangeAddress.StartColumn 539*b1cdbd2cSJim JagielskiEnd Function 540*b1cdbd2cSJim Jagielski 541*b1cdbd2cSJim Jagielski 542*b1cdbd2cSJim JagielskiFunction CopySheetbyName(oSheets as Object, OldName as String, NewName as String, DestPos as Integer) as Object 543*b1cdbd2cSJim JagielskiDim oSheet as Object 544*b1cdbd2cSJim JagielskiDim Count as Integer 545*b1cdbd2cSJim JagielskiDim BasicSheetName as String 546*b1cdbd2cSJim Jagielski 547*b1cdbd2cSJim Jagielski BasicSheetName = NewName 548*b1cdbd2cSJim Jagielski ' Copy the last table. Assumption: The last table is the template 549*b1cdbd2cSJim Jagielski On Local Error Goto RENAMESHEET 550*b1cdbd2cSJim Jagielski oSheets.CopybyName(OldName, NewName, DestPos) 551*b1cdbd2cSJim Jagielski 552*b1cdbd2cSJim JagielskiRENAMESHEET: 553*b1cdbd2cSJim Jagielski oSheet = oSheets(DestPos) 554*b1cdbd2cSJim Jagielski If Err <> 0 Then 555*b1cdbd2cSJim Jagielski ' Test if renaming failed 556*b1cdbd2cSJim Jagielski Count = 2 557*b1cdbd2cSJim Jagielski Do While oSheet.Name <> NewName 558*b1cdbd2cSJim Jagielski NewName = BasicSheetName & "_" & Count 559*b1cdbd2cSJim Jagielski oSheet.Name = NewName 560*b1cdbd2cSJim Jagielski Count = Count + 1 561*b1cdbd2cSJim Jagielski Loop 562*b1cdbd2cSJim Jagielski Resume CL_ERROR 563*b1cdbd2cSJim JagielskiCL_ERROR: 564*b1cdbd2cSJim Jagielski End If 565*b1cdbd2cSJim Jagielski CopySheetbyName = oSheet 566*b1cdbd2cSJim JagielskiEnd Function 567*b1cdbd2cSJim Jagielski 568*b1cdbd2cSJim Jagielski 569*b1cdbd2cSJim Jagielski' Dis-or enables a Window and adjusts the mousepointer accordingly 570*b1cdbd2cSJim JagielskiSub ToggleWindow(bDoEnable as Boolean) 571*b1cdbd2cSJim JagielskiDim oWindow as Object 572*b1cdbd2cSJim Jagielski oWindow = StarDesktop.CurrentFrame.ComponentWindow 573*b1cdbd2cSJim Jagielski oWindow.Enable = bDoEnable 574*b1cdbd2cSJim JagielskiEnd Sub 575*b1cdbd2cSJim Jagielski 576*b1cdbd2cSJim Jagielski 577*b1cdbd2cSJim JagielskiFunction CheckNewSheetname(oSheets as Object, Sheetname as String, Optional oLocale) as String 578*b1cdbd2cSJim JagielskiDim nStartFlags as Long 579*b1cdbd2cSJim JagielskiDim nContFlags as Long 580*b1cdbd2cSJim JagielskiDim oCharService as Object 581*b1cdbd2cSJim JagielskiDim iSheetNameLength as Integer 582*b1cdbd2cSJim JagielskiDim iResultPos as Integer 583*b1cdbd2cSJim JagielskiDim WrongChar as String 584*b1cdbd2cSJim JagielskiDim oResult as Object 585*b1cdbd2cSJim Jagielski nStartFlags = com.sun.star.i18n.KParseTokens.ANY_LETTER_OR_NUMBER + com.sun.star.i18n.KParseTokens.ASC_UNDERSCORE 586*b1cdbd2cSJim Jagielski nContFlags = nStartFlags 587*b1cdbd2cSJim Jagielski oCharService = CreateUnoService("com.sun.star.i18n.CharacterClassification") 588*b1cdbd2cSJim Jagielski iSheetNameLength = Len(SheetName) 589*b1cdbd2cSJim Jagielski If IsMissing(oLocale) Then 590*b1cdbd2cSJim Jagielski oLocale = ThisComponent.CharLocale 591*b1cdbd2cSJim Jagielski End If 592*b1cdbd2cSJim Jagielski Do 593*b1cdbd2cSJim Jagielski oResult =oCharService.parsePredefinedToken(com.sun.star.i18n.KParseType.IDENTNAME, SheetName, 0, oLocale, nStartFlags, "", nContFlags, " ") 594*b1cdbd2cSJim Jagielski iResultPos = oResult.EndPos 595*b1cdbd2cSJim Jagielski If iResultPos < iSheetNameLength Then 596*b1cdbd2cSJim Jagielski WrongChar = Mid(SheetName, iResultPos+1,1) 597*b1cdbd2cSJim Jagielski SheetName = ReplaceString(SheetName,"_", WrongChar) 598*b1cdbd2cSJim Jagielski End If 599*b1cdbd2cSJim Jagielski Loop Until iResultPos = iSheetNameLength 600*b1cdbd2cSJim Jagielski CheckNewSheetname = SheetName 601*b1cdbd2cSJim JagielskiEnd Function 602*b1cdbd2cSJim Jagielski 603*b1cdbd2cSJim Jagielski 604*b1cdbd2cSJim JagielskiSub AddNewSheetName(oSheets as Object, ByVal SheetName as String) 605*b1cdbd2cSJim JagielskiDim Count as Integer 606*b1cdbd2cSJim JagielskiDim bSheetIsThere as Boolean 607*b1cdbd2cSJim JagielskiDim iSheetNameLength as Integer 608*b1cdbd2cSJim Jagielski iSheetNameLength = Len(SheetName) 609*b1cdbd2cSJim Jagielski Count = 2 610*b1cdbd2cSJim Jagielski Do 611*b1cdbd2cSJim Jagielski bSheetIsThere = oSheets.HasByName(SheetName) 612*b1cdbd2cSJim Jagielski If bSheetIsThere Then 613*b1cdbd2cSJim Jagielski SheetName = Right(SheetName,iSheetNameLength) & "_" & Count 614*b1cdbd2cSJim Jagielski Count = Count + 1 615*b1cdbd2cSJim Jagielski End If 616*b1cdbd2cSJim Jagielski Loop Until Not bSheetIsThere 617*b1cdbd2cSJim Jagielski AddNewSheetname = SheetName 618*b1cdbd2cSJim JagielskiEnd Sub 619*b1cdbd2cSJim Jagielski 620*b1cdbd2cSJim Jagielski 621*b1cdbd2cSJim JagielskiFunction GetSheetIndex(oSheets, sName) as Integer 622*b1cdbd2cSJim JagielskiDim i as Integer 623*b1cdbd2cSJim Jagielski For i = 0 To oSheets.Count-1 624*b1cdbd2cSJim Jagielski If oSheets(i).Name = sName Then 625*b1cdbd2cSJim Jagielski GetSheetIndex = i 626*b1cdbd2cSJim Jagielski exit Function 627*b1cdbd2cSJim Jagielski End If 628*b1cdbd2cSJim Jagielski Next i 629*b1cdbd2cSJim Jagielski GetSheetIndex = -1 630*b1cdbd2cSJim JagielskiEnd Function 631*b1cdbd2cSJim Jagielski 632*b1cdbd2cSJim Jagielski 633*b1cdbd2cSJim JagielskiFunction GetLastUsedRow(oSheet as Object) as Integer 634*b1cdbd2cSJim JagielskiDim oCell As Object 635*b1cdbd2cSJim JagielskiDim oCursor As Object 636*b1cdbd2cSJim JagielskiDim aAddress As Variant 637*b1cdbd2cSJim Jagielski oCell = oSheet.GetCellbyPosition(0, 0) 638*b1cdbd2cSJim Jagielski oCursor = oSheet.createCursorByRange(oCell) 639*b1cdbd2cSJim Jagielski oCursor.GotoEndOfUsedArea(True) 640*b1cdbd2cSJim Jagielski aAddress = oCursor.RangeAddress 641*b1cdbd2cSJim Jagielski GetLastUsedRow = aAddress.EndRow 642*b1cdbd2cSJim JagielskiEnd Function 643*b1cdbd2cSJim Jagielski 644*b1cdbd2cSJim Jagielski 645*b1cdbd2cSJim Jagielski' Note To set a one lined frame you have to set the inner width to 0 646*b1cdbd2cSJim Jagielski' In the API all Units that refer to pt-Heights are "1/100mm" 647*b1cdbd2cSJim Jagielski' The convert factor from 1pt to 1/100 mm is approximately 35 648*b1cdbd2cSJim JagielskiFunction ModifyBorderLineWidth(ByVal oStyleBorder, iInnerLineWidth as Integer, iOuterLineWidth as Integer) 649*b1cdbd2cSJim JagielskiDim aBorder as New com.sun.star.table.BorderLine 650*b1cdbd2cSJim Jagielski aBorder = oStyleBorder 651*b1cdbd2cSJim Jagielski aBorder.InnerLineWidth = iInnerLineWidth 652*b1cdbd2cSJim Jagielski aBorder.OuterLineWidth = iOuterLineWidth 653*b1cdbd2cSJim Jagielski ModifyBorderLineWidth = aBorder 654*b1cdbd2cSJim JagielskiEnd Function 655*b1cdbd2cSJim Jagielski 656*b1cdbd2cSJim Jagielski 657*b1cdbd2cSJim JagielskiSub AttachBasicMacroToEvent(oDocument as Object, EventName as String, SubPath as String) 658*b1cdbd2cSJim JagielskiDim PropValue(1) as new com.sun.star.beans.PropertyValue 659*b1cdbd2cSJim Jagielski PropValue(0).Name = "EventType" 660*b1cdbd2cSJim Jagielski PropValue(0).Value = "StarBasic" 661*b1cdbd2cSJim Jagielski PropValue(1).Name = "Script" 662*b1cdbd2cSJim Jagielski PropValue(1).Value = "macro:///" & SubPath 663*b1cdbd2cSJim Jagielski oDocument.Events.ReplaceByName(EventName, PropValue()) 664*b1cdbd2cSJim JagielskiEnd Sub 665*b1cdbd2cSJim Jagielski 666*b1cdbd2cSJim Jagielski 667*b1cdbd2cSJim Jagielski 668*b1cdbd2cSJim JagielskiFunction ModifyPropertyValue(oContent() as New com.sun.star.beans.PropertyValue, TargetProperties() as New com.sun.star.beans.PropertyValue) 669*b1cdbd2cSJim JagielskiDim MaxIndex as Integer 670*b1cdbd2cSJim JagielskiDim i as Integer 671*b1cdbd2cSJim JagielskiDim a as Integer 672*b1cdbd2cSJim Jagielski MaxIndex = Ubound(oContent()) 673*b1cdbd2cSJim Jagielski bDoReplace = False 674*b1cdbd2cSJim Jagielski For i = 0 To MaxIndex 675*b1cdbd2cSJim Jagielski a = GetPropertyValueIndex(oContent(i).Name, TargetProperties()) 676*b1cdbd2cSJim Jagielski If a <> -1 Then 677*b1cdbd2cSJim Jagielski If Vartype(TargetProperties(a).Value) <> 9 Then 678*b1cdbd2cSJim Jagielski If TargetProperties(a).Value <> oContent(i).Value Then 679*b1cdbd2cSJim Jagielski oContent(i).Value = TargetProperties(a).Value 680*b1cdbd2cSJim Jagielski bDoReplace = True 681*b1cdbd2cSJim Jagielski End If 682*b1cdbd2cSJim Jagielski Else 683*b1cdbd2cSJim Jagielski If Not EqualUnoObjects(TargetProperties(a).Value, oContent(i).Value) Then 684*b1cdbd2cSJim Jagielski oContent(i).Value = TargetProperties(a).Value 685*b1cdbd2cSJim Jagielski bDoReplace = True 686*b1cdbd2cSJim Jagielski End If 687*b1cdbd2cSJim Jagielski End If 688*b1cdbd2cSJim Jagielski End If 689*b1cdbd2cSJim Jagielski Next i 690*b1cdbd2cSJim Jagielski ModifyPropertyValue() = bDoReplace 691*b1cdbd2cSJim JagielskiEnd Function 692*b1cdbd2cSJim Jagielski 693*b1cdbd2cSJim Jagielski 694*b1cdbd2cSJim JagielskiFunction GetPropertyValueIndex(SearchName as String, TargetProperties() as New com.sun.star.beans.PropertyValue ) as Integer 695*b1cdbd2cSJim JagielskiDim i as Integer 696*b1cdbd2cSJim Jagielski For i = 0 To Ubound(TargetProperties()) 697*b1cdbd2cSJim Jagielski If Searchname = TargetProperties(i).Name Then 698*b1cdbd2cSJim Jagielski GetPropertyValueIndex = i 699*b1cdbd2cSJim Jagielski Exit Function 700*b1cdbd2cSJim Jagielski End If 701*b1cdbd2cSJim Jagielski Next i 702*b1cdbd2cSJim Jagielski GetPropertyValueIndex() = -1 703*b1cdbd2cSJim JagielskiEnd Function 704*b1cdbd2cSJim Jagielski 705*b1cdbd2cSJim Jagielski 706*b1cdbd2cSJim JagielskiSub DispatchSlot(SlotID as Integer) 707*b1cdbd2cSJim JagielskiDim oArg() as new com.sun.star.beans.PropertyValue 708*b1cdbd2cSJim JagielskiDim oUrl as new com.sun.star.util.URL 709*b1cdbd2cSJim JagielskiDim oTrans as Object 710*b1cdbd2cSJim JagielskiDim oDisp as Object 711*b1cdbd2cSJim Jagielski oTrans = createUNOService("com.sun.star.util.URLTransformer") 712*b1cdbd2cSJim Jagielski oUrl.Complete = "slot:" & CStr(SlotID) 713*b1cdbd2cSJim Jagielski oTrans.parsestrict(oUrl) 714*b1cdbd2cSJim Jagielski oDisp = StarDesktop.ActiveFrame.queryDispatch(oUrl, "_self", 0) 715*b1cdbd2cSJim Jagielski oDisp.dispatch(oUrl, oArg()) 716*b1cdbd2cSJim JagielskiEnd Sub 717*b1cdbd2cSJim Jagielski 718*b1cdbd2cSJim Jagielski 719*b1cdbd2cSJim Jagielski'returns the type of the office application 720*b1cdbd2cSJim Jagielski'FatOffice = 0, WebTop = 1 721*b1cdbd2cSJim Jagielski'This routine has to be changed if the Product Name is being changed! 722*b1cdbd2cSJim JagielskiFunction IsFatOffice() As Boolean 723*b1cdbd2cSJim Jagielski If sProductname = "" Then 724*b1cdbd2cSJim Jagielski sProductname = GetProductname() 725*b1cdbd2cSJim Jagielski End If 726*b1cdbd2cSJim Jagielski IsFatOffice = TRUE 727*b1cdbd2cSJim Jagielski 'The following line has to include the current productname 728*b1cdbd2cSJim Jagielski If Instr(1,sProductname,"WebTop",1) <> 0 Then 729*b1cdbd2cSJim Jagielski IsFatOffice = FALSE 730*b1cdbd2cSJim Jagielski End If 731*b1cdbd2cSJim JagielskiEnd Function 732*b1cdbd2cSJim Jagielski 733*b1cdbd2cSJim Jagielski 734*b1cdbd2cSJim JagielskiFunction GetLocale(sLanguage as String, sCountry as String) 735*b1cdbd2cSJim JagielskiDim oLocale as New com.sun.star.lang.Locale 736*b1cdbd2cSJim Jagielski oLocale.Language = sLanguage 737*b1cdbd2cSJim Jagielski oLocale.Country = sCountry 738*b1cdbd2cSJim Jagielski GetLocale = oLocale 739*b1cdbd2cSJim JagielskiEnd Function 740*b1cdbd2cSJim Jagielski 741*b1cdbd2cSJim Jagielski 742*b1cdbd2cSJim JagielskiSub ToggleDesignMode(oDocument as Object) 743*b1cdbd2cSJim JagielskiDim aSwitchMode as new com.sun.star.util.URL 744*b1cdbd2cSJim Jagielski aSwitchMode.Complete = ".uno:SwitchControlDesignMode" 745*b1cdbd2cSJim Jagielski aTransformer = createUnoService("com.sun.star.util.URLTransformer") 746*b1cdbd2cSJim Jagielski aTransformer.parseStrict(aSwitchMode) 747*b1cdbd2cSJim Jagielski oFrame = oDocument.currentController.Frame 748*b1cdbd2cSJim Jagielski oDispatch = oFrame.queryDispatch(aSwitchMode, oFrame.Name, 63) 749*b1cdbd2cSJim Jagielski Dim aEmptyArgs() as New com.sun.star.bean.PropertyValue 750*b1cdbd2cSJim Jagielski oDispatch.dispatch(aSwitchMode, aEmptyArgs()) 751*b1cdbd2cSJim Jagielski Erase aSwitchMode 752*b1cdbd2cSJim JagielskiEnd Sub 753*b1cdbd2cSJim Jagielski 754*b1cdbd2cSJim Jagielski 755*b1cdbd2cSJim JagielskiFunction isHighContrast(oPeer as Object) 756*b1cdbd2cSJim Jagielski Dim UIColor as Long 757*b1cdbd2cSJim Jagielski Dim myRed as Integer 758*b1cdbd2cSJim Jagielski Dim myGreen as Integer 759*b1cdbd2cSJim Jagielski Dim myBlue as Integer 760*b1cdbd2cSJim Jagielski Dim myLuminance as Double 761*b1cdbd2cSJim Jagielski 762*b1cdbd2cSJim Jagielski UIColor = oPeer.getProperty( "DisplayBackgroundColor" ) 763*b1cdbd2cSJim Jagielski myRed = Red (UIColor) 764*b1cdbd2cSJim Jagielski myGreen = Green (UIColor) 765*b1cdbd2cSJim Jagielski myBlue = Blue (UIColor) 766*b1cdbd2cSJim Jagielski myLuminance = (( myBlue*28 + myGreen*151 + myRed*77 ) / 256 ) 767*b1cdbd2cSJim Jagielski isHighContrast = false 768*b1cdbd2cSJim Jagielski If myLuminance <= 25 Then isHighContrast = true 769*b1cdbd2cSJim JagielskiEnd Function 770*b1cdbd2cSJim Jagielski 771*b1cdbd2cSJim Jagielski 772*b1cdbd2cSJim JagielskiFunction CreateNewDocument(sType as String, Optional sAddMsg as String) as Object 773*b1cdbd2cSJim JagielskiDim NoArgs() as new com.sun.star.beans.PropertyValue 774*b1cdbd2cSJim JagielskiDim oDocument as Object 775*b1cdbd2cSJim JagielskiDim sUrl as String 776*b1cdbd2cSJim JagielskiDim ErrMsg as String 777*b1cdbd2cSJim Jagielski On Local Error Goto NOMODULEINSTALLED 778*b1cdbd2cSJim Jagielski sUrl = "private:factory/" & sType 779*b1cdbd2cSJim Jagielski oDocument = StarDesktop.LoadComponentFromURL(sUrl,"_default",0, NoArgs()) 780*b1cdbd2cSJim JagielskiNOMODULEINSTALLED: 781*b1cdbd2cSJim Jagielski If (Err <> 0) OR IsNull(oDocument) Then 782*b1cdbd2cSJim Jagielski If InitResources("", "com") Then 783*b1cdbd2cSJim Jagielski Select Case sType 784*b1cdbd2cSJim Jagielski Case "swriter" 785*b1cdbd2cSJim Jagielski ErrMsg = GetResText(1001) 786*b1cdbd2cSJim Jagielski Case "scalc" 787*b1cdbd2cSJim Jagielski ErrMsg = GetResText(1002) 788*b1cdbd2cSJim Jagielski Case "simpress" 789*b1cdbd2cSJim Jagielski ErrMsg = GetResText(1003) 790*b1cdbd2cSJim Jagielski Case "sdraw" 791*b1cdbd2cSJim Jagielski ErrMsg = GetResText(1004) 792*b1cdbd2cSJim Jagielski Case "smath" 793*b1cdbd2cSJim Jagielski ErrMsg = GetResText(1005) 794*b1cdbd2cSJim Jagielski Case Else 795*b1cdbd2cSJim Jagielski ErrMsg = "Invalid Document Type!" 796*b1cdbd2cSJim Jagielski End Select 797*b1cdbd2cSJim Jagielski ErrMsg = ReplaceString(ErrMsg, chr(13), "<BR>") 798*b1cdbd2cSJim Jagielski If Not IsMissing(sAddMsg) Then 799*b1cdbd2cSJim Jagielski ErrMsg = ErrMsg & chr(13) & sAddMsg 800*b1cdbd2cSJim Jagielski End If 801*b1cdbd2cSJim Jagielski Msgbox(ErrMsg, 48, GetProductName()) 802*b1cdbd2cSJim Jagielski End If 803*b1cdbd2cSJim Jagielski If Err <> 0 Then 804*b1cdbd2cSJim Jagielski Resume GOON 805*b1cdbd2cSJim Jagielski End If 806*b1cdbd2cSJim Jagielski End If 807*b1cdbd2cSJim JagielskiGOON: 808*b1cdbd2cSJim Jagielski CreateNewDocument = oDocument 809*b1cdbd2cSJim JagielskiEnd Function 810*b1cdbd2cSJim Jagielski 811*b1cdbd2cSJim Jagielski 812*b1cdbd2cSJim Jagielski' This Sub has been used in order to ensure that after disposing a document 813*b1cdbd2cSJim Jagielski' from the backing window it is returned to the backing window, so the 814*b1cdbd2cSJim Jagielski' office won't be closed 815*b1cdbd2cSJim JagielskiSub DisposeDocument(oDocument as Object) 816*b1cdbd2cSJim JagielskiDim dispatcher as Object 817*b1cdbd2cSJim JagielskiDim parser as Object 818*b1cdbd2cSJim JagielskiDim disp as Object 819*b1cdbd2cSJim JagielskiDim url as new com.sun.star.util.URL 820*b1cdbd2cSJim JagielskiDim NoArgs() as New com.sun.star.beans.PropertyValue 821*b1cdbd2cSJim JagielskiDim oFrame as Object 822*b1cdbd2cSJim Jagielski If Not IsNull(oDocument) Then 823*b1cdbd2cSJim Jagielski oDocument.setModified(false) 824*b1cdbd2cSJim Jagielski parser = createUnoService("com.sun.star.util.URLTransformer") 825*b1cdbd2cSJim Jagielski url.Complete = ".uno:CloseDoc" 826*b1cdbd2cSJim Jagielski parser.parseStrict(url) 827*b1cdbd2cSJim Jagielski oFrame = oDocument.CurrentController.Frame 828*b1cdbd2cSJim Jagielski disp = oFrame.queryDispatch(url,"_self", com.sun.star.util.SearchFlags.NORM_WORD_ONLY) 829*b1cdbd2cSJim Jagielski disp.dispatch(url, NoArgs()) 830*b1cdbd2cSJim Jagielski End If 831*b1cdbd2cSJim JagielskiEnd Sub 832*b1cdbd2cSJim Jagielski 833*b1cdbd2cSJim Jagielski'Function to calculate if the year is a leap year 834*b1cdbd2cSJim JagielskiFunction CalIsLeapYear(ByVal iYear as Integer) as Boolean 835*b1cdbd2cSJim Jagielski CalIsLeapYear = ((iYear Mod 4 = 0) And ((iYear Mod 100 <> 0) Or (iYear Mod 400 = 0))) 836*b1cdbd2cSJim JagielskiEnd Function 837*b1cdbd2cSJim Jagielski</script:module> 838