| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843 |
- <?xml version="1.0" encoding="UTF-8"?>
- <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
- <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Calc" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
- REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
- REM === The SFDocuments library is one of the associated libraries. ===
- REM === Full documentation is available on https://help.libreoffice.org/ ===
- REM =======================================================================================================================
- Option Compatible
- Option ClassModule
- Option Explicit
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- ''' SF_Calc
- ''' =======
- '''
- ''' The SFDocuments library gathers a number of methods and properties making easy
- ''' the management and several manipulations of LibreOffice documents
- '''
- ''' Some methods are generic for all types of documents: they are combined in the SF_Document module.
- ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Writer, ...
- '''
- ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary
- ''' Each subclass MUST implement also the generic methods and properties, even if they only call
- ''' the parent methods and properties.
- ''' They should also duplicate some generic private members as a subset of their own set of members
- '''
- ''' The SF_Calc module is focused on :
- ''' - management (copy, insert, move, ...) of sheets within a Calc document
- ''' - exchange of data between Basic data structures and Calc ranges of values
- '''
- ''' The current module is closely related to the "UI" service of the ScriptForge library
- '''
- ''' Service invocation examples:
- ''' 1) From the UI service
- ''' Dim ui As Object, oDoc As Object
- ''' Set ui = CreateScriptService("UI")
- ''' Set oDoc = ui.CreateDocument("Calc", ...)
- ''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.ods")
- ''' 2) Directly if the document is already opened
- ''' Dim oDoc As Object
- ''' Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Default = ActiveWindow
- ''' ' or Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Untitled 1 is presumed a Calc document
- ''' ' The substring "SFDocuments." in the service name is optional
- '''
- ''' Definitions:
- ''' Many methods require a "Sheet" or a "Range" as argument. (NB: a single cell is considered as a special case of a Range)
- ''' Usually, within a specific Calc instance, sheets and ranges are given as a string: "SheetX" and "D2:F6"
- ''' Multiple ranges are not supported in this context.
- ''' Additionally, the .Sheet and .Range methods return a reference that may be used
- ''' as argument of a method called from another instance of the Calc service
- ''' Example:
- ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\FileA.ods", Hidden := True, ReadOnly := True)
- ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\FileB.ods")
- ''' oDocB.CopyToRange(oDocA.Range("SheetX.D4:F8"), "D2:F6") ' CopyToRange(source, target)
- '''
- ''' Sheet: the sheet name as a string or an object produced by .Sheet()
- ''' "~" = current sheet
- ''' Range: a string designating a set of contiguous cells located in a sheet of the current instance
- ''' "~" = current selection (if multiple selections, its 1st component)
- ''' or an object produced by .Range()
- ''' The sheet name is optional (default = active sheet). Surrounding quotes and $ signs are optional
- ''' ~.~, ~ The current selection in the active sheet
- ''' '$SheetX'.D2 or $D$2 A single cell
- ''' '$SheetX'.D2:F6, D2:D10 Multiple cells
- ''' '$SheetX'.A:A or 3:5 All cells in the same column or row up to the last active cell
- ''' SheetX.* All cells up to the last active cell
- ''' myRange A range name at spreadsheet level
- ''' ~.yourRange, SheetX.someRange A range name at sheet level
- ''' myDoc.Range("SheetX.D2:F6")
- ''' A range within the sheet SheetX in file associated with the myDoc Calc instance
- '''
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- REM ================================================================== EXCEPTIONS
- Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR"
- Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR"
- Private Const CALCADDRESSERROR = "CALCADDRESSERROR"
- Private Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR"
- Private Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR"
- REM ============================================================= PRIVATE MEMBERS
- Private [Me] As Object
- Private [_Parent] As Object
- Private [_Super] As Object ' Document superclass, which the current instance is a subclass of
- Private ObjectType As String ' Must be CALC
- Private ServiceName As String
- ' Window component
- Private _Component As Object ' com.sun.star.lang.XComponent
- Type _Address
- ObjectType As String ' Must be "SF_CalcReference"
- RawAddress As String
- Component As Object ' com.sun.star.lang.XComponent
- SheetName As String
- SheetIndex As Integer
- RangeName As String
- Height As Long
- Width As Long
- XSpreadSheet As Object ' com.sun.star.sheet.XSpreadsheet
- XCellRange As Object ' com.sun.star.table.XCellRange
- End Type
- REM ============================================================ MODULE CONSTANTS
- Private Const cstSHEET = 1
- Private Const cstRANGE = 2
- Private Const MAXCOLS = 2^10 ' Max number of columns in a sheet
- Private Const MAXROWS = 2^20 ' Max number of rows in a sheet
- Private Const CALCREFERENCE = "SF_CalcReference" ' Object type of _Address
- REM ===================================================== CONSTRUCTOR/DESTRUCTOR
- REM -----------------------------------------------------------------------------
- Private Sub Class_Initialize()
- Set [Me] = Nothing
- Set [_Parent] = Nothing
- Set [_Super] = Nothing
- ObjectType = "CALC"
- ServiceName = "SFDocuments.Calc"
- Set _Component = Nothing
- End Sub ' SFDocuments.SF_Calc Constructor
- REM -----------------------------------------------------------------------------
- Private Sub Class_Terminate()
- Call Class_Initialize()
- End Sub ' SFDocuments.SF_Calc Destructor
- REM -----------------------------------------------------------------------------
- Public Function Dispose() As Variant
- If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose()
- Call Class_Terminate()
- Set Dispose = Nothing
- End Function ' SFDocuments.SF_Calc Explicit Destructor
- REM ================================================================== PROPERTIES
- REM -----------------------------------------------------------------------------
- Property Get CurrentSelection() As Variant
- ''' Returns as a string the currently selected range or as an array the list of the currently selected ranges
- CurrentSelection = _PropertyGet("CurrentSelection")
- End Property ' SFDocuments.SF_Calc.CurrentSelection (get)
- REM -----------------------------------------------------------------------------
- Property Let CurrentSelection(Optional ByVal pvSelection As Variant)
- ''' Set the selection to a single or a multiple range
- ''' The argument is a string or an array of strings
- Dim sRange As String ' A single selection
- Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
- Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
- Dim i As Long
- Const cstThisSub = "SFDocuments.Calc.setCurrentSelection"
- Const cstSubArgs = "Selection"
- On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If IsArray(pvSelection) Then
- If Not ScriptForge.SF_Utils._ValidateArray(pvSelection, "pvSelection", 1, V_STRING, True) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(pvSelection, "pvSelection", V_STRING) Then GoTo Finally
- End If
- End If
- Try:
- If IsArray(pvSelection) Then
- Set oCellRanges = _Component.createInstance("com.sun.star.sheet.SheetCellRanges")
- vRangeAddresses = Array()
- ReDim vRangeAddresses(0 To UBound(pvSelection))
- For i = 0 To UBound(pvSelection)
- vRangeAddresses(i) = Range(pvSelection(i)).XCellRange.RangeAddress
- Next i
- oCellRanges.addRangeAddresses(vRangeAddresses, False)
- _Component.CurrentController.select(oCellRanges)
- Else
- _Component.CurrentController.select(_ParseAddress(pvSelection).XCellRange)
- End If
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Property
- Catch:
- GoTo Finally
- End Property ' SFDocuments.SF_Calc.CurrentSelection (let)
- REM -----------------------------------------------------------------------------
- Property Get Height(Optional ByVal RangeName As Variant) As Long
- ''' Returns the height in # of rows of the given range
- Height = _PropertyGet("Height", RangeName)
- End Property ' SFDocuments.SF_Calc.Height
- REM -----------------------------------------------------------------------------
- Property Get LastCell(Optional ByVal SheetName As Variant) As String
- ''' Returns the last used cell in a given sheet
- LastCell = _PropertyGet("LastCell", SheetName)
- End Property ' SFDocuments.SF_Calc.LastCell
- REM -----------------------------------------------------------------------------
- Property Get LastColumn(Optional ByVal SheetName As Variant) As Long
- ''' Returns the last used column in a given sheet
- LastColumn = _PropertyGet("LastColumn", SheetName)
- End Property ' SFDocuments.SF_Calc.LastColumn
- REM -----------------------------------------------------------------------------
- Property Get LastRow(Optional ByVal SheetName As Variant) As Long
- ''' Returns the last used column in a given sheet
- LastRow = _PropertyGet("LastRow", SheetName)
- End Property ' SFDocuments.SF_Calc.LastRow
- REM -----------------------------------------------------------------------------
- Property Get Range(Optional ByVal RangeName As Variant) As Variant
- ''' Returns a (internal) range object
- Range = _PropertyGet("Range", RangeName)
- End Property ' SFDocuments.SF_Calc.Range
- REM -----------------------------------------------------------------------------
- Property Get Sheet(Optional ByVal SheetName As Variant) As Variant
- ''' Returns a (internal) sheet object
- Sheet = _PropertyGet("Sheet", SheetName)
- End Property ' SFDocuments.SF_Calc.Sheet
- REM -----------------------------------------------------------------------------
- Property Get Sheets() As Variant
- ''' Returns an array listing the existing sheet names
- Sheets = _PropertyGet("Sheets")
- End Property ' SFDocuments.SF_Calc.Sheets
- REM -----------------------------------------------------------------------------
- Property Get Width(Optional ByVal RangeName As Variant) As Long
- ''' Returns the width in # of columns of the given range
- Width = _PropertyGet("Width", RangeName)
- End Property ' SFDocuments.SF_Calc.Width
- REM -----------------------------------------------------------------------------
- Property Get XCellRange(Optional ByVal RangeName As Variant) As Variant
- ''' Returns a UNO object of type com.sun.star.Table.CellRange
- XCellRange = _PropertyGet("XCellRange", RangeName)
- End Property ' SFDocuments.SF_Calc.XCellRange
- REM -----------------------------------------------------------------------------
- Property Get XSpreadsheet(Optional ByVal SheetName As Variant) As Variant
- ''' Returns a UNO object of type com.sun.star.sheet.XSpreadsheet
- XSpreadsheet = _PropertyGet("XSpreadsheet", SheetName)
- End Property ' SFDocuments.SF_Calc.XSpreadsheet
- REM ===================================================================== METHODS
- REM -----------------------------------------------------------------------------
- Public Function Activate(Optional ByVal SheetName As Variant) As Boolean
- ''' Make the current document or the given sheet active
- ''' Args:
- ''' SheetName: Default = the Calc document as a whole
- ''' Returns:
- ''' True if the document or the sheet could be made active
- ''' Otherwise, there is no change in the actual user interface
- ''' Examples:
- ''' oDoc.Activate("SheetX")
- Dim bActive As Boolean ' Return value
- Dim oSheet As Object ' Reference to sheet
- Const cstThisSub = "SFDocuments.Calc.Activate"
- Const cstSubArgs = "[SheetName]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bActive = False
- Check:
- If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , , True) Then GoTo Finally
- End If
- Try:
- ' Sheet activation, to do only when meaningful, precedes document activation
- If Len(SheetName) > 0 Then
- With _Component
- Set oSheet = .getSheets.getByName(SheetName)
- Set .CurrentController.ActiveSheet = oSheet
- End With
- End If
- bActive = [_Super].Activate()
- Finally:
- Activate = bActive
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.Activate
- REM -----------------------------------------------------------------------------
- Public Sub ClearAll(Optional ByVal Range As Variant) As String
- ''' Clear entirely the given range
- ''' Args:
- ''' Range : the cell or the range as a string that should be cleared
- ''' Examples:
- ''' oDoc.ClearAll("SheetX") ' Clears the used area of the sheet
- Dim lClear As Long ' The elements to clear
- Dim oRange As Object ' Alias of Range
- Const cstThisSub = "SFDocuments.Calc.ClearAll"
- Const cstSubArgs = "Range"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- End If
- Try:
- With com.sun.star.sheet.CellFlags
- lClear = 0 _
- + .VALUE _
- + .DATETIME _
- + .STRING _
- + .ANNOTATION _
- + .FORMULA _
- + .HARDATTR _
- + .STYLES _
- + .OBJECTS _
- + .EDITATTR _
- + .FORMATTED
- Set oRange = _ParseAddress(Range)
- oRange.XCellRange.clearContents(lClear)
- End With
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- End Sub ' SF_Documents.SF_Calc.ClearAll
- REM -----------------------------------------------------------------------------
- Public Sub ClearFormats(Optional ByVal Range As Variant) As String
- ''' Clear all the formatting elements of the given range
- ''' Args:
- ''' Range : the cell or the range as a string that should be cleared
- ''' Examples:
- ''' oDoc.ClearFormats("SheetX:A1:E100") ' Clear the formats of the given range
- Dim lClear As Long ' The elements to clear
- Dim oRange As Object ' Alias of Range
- Const cstThisSub = "SFDocuments.Calc.ClearFormats"
- Const cstSubArgs = "Range"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- End If
- Try:
- With com.sun.star.sheet.CellFlags
- lClear = 0 _
- + .HARDATTR _
- + .STYLES _
- + .EDITATTR _
- + .FORMATTED
- Set oRange = _ParseAddress(Range)
- oRange.XCellRange.clearContents(lClear)
- End With
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- End Sub ' SF_Documents.SF_Calc.ClearFormats
- REM -----------------------------------------------------------------------------
- Public Sub ClearValues(Optional ByVal Range As Variant) As String
- ''' Clear values and formulas in the given range
- ''' Args:
- ''' Range : the cell or the range as a string that should be cleared
- ''' Examples:
- ''' oDoc.ClearValues("SheetX:*") ' Clears the used area of the sheet
- Dim lClear As Long ' The elements to clear
- Dim oRange As Object ' Alias of Range
- Const cstThisSub = "SFDocuments.Calc.ClearValues"
- Const cstSubArgs = "Range"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- End If
- Try:
- With com.sun.star.sheet.CellFlags
- lClear = 0 _
- + .VALUE _
- + .DATETIME _
- + .STRING _
- + .FORMULA
- Set oRange = _ParseAddress(Range)
- oRange.XCellRange.clearContents(lClear)
- End With
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- End Sub ' SF_Documents.SF_Calc.ClearValues
- REM -----------------------------------------------------------------------------
- Public Function CopySheet(Optional ByVal SheetName As Variant _
- , Optional ByVal NewName As Variant _
- , Optional ByVal BeforeSheet As Variant _
- ) As Boolean
- ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets
- ''' The sheet to copy may be inside any open Calc document
- ''' Args:
- ''' SheetName: The name of the sheet to copy or its reference
- ''' NewName: Must not exist
- ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
- ''' Returns:
- ''' True if the sheet could be copied successfully
- ''' Exceptions:
- ''' DUPLICATESHEETERROR A sheet with the given name exists already
- ''' Examples:
- ''' oDoc.CopySheet("SheetX", "SheetY")
- ''' ' Copy within the same document
- ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
- ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
- ''' oDocB.CopySheet(oDocA.Sheet("SheetX"), "SheetY")
- ''' ' Copy from 1 file to another and put the new sheet at the end
- Dim bCopy As Boolean ' Return value
- Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets
- Dim vSheets As Variant ' List of existing sheets
- Dim lSheetIndex As Long ' Index of a sheet
- Dim oSheet As Object ' Alias of SheetName as reference
- Dim lRandom As Long ' Output of random number generator
- Dim sRandom ' Random sheet name
- Const cstThisSub = "SFDocuments.Calc.CopySheet"
- Const cstSubArgs = "SheetName, NewName, [BeforeSheet=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bCopy = False
- Check:
- If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True, , , True) Then GoTo Finally
- If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally
- If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally
- End If
- Try:
- ' Determine the index of the sheet before which to insert the copy
- Set oSheets = _Component.getSheets
- vSheets = oSheets.getElementNames()
- If VarType(BeforeSheet) = V_STRING Then
- lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
- Else
- lSheetIndex = BeforeSheet - 1
- If lSheetIndex < 0 Then lSheetIndex = 0
- If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1
- End If
- ' Copy sheet inside the same document OR import from another document
- If VarType(SheetName) = V_STRING Then
- _Component.getSheets.copyByName(SheetName, NewName, lSheetIndex)
- Else
- Set oSheet = SheetName
- With oSheet
- ' If a sheet with same name as input exists in the target sheet, rename it first with a random name
- sRandom = ""
- If ScriptForge.SF_Array.Contains(vSheets, .SheetName) Then
- lRandom = ScriptForge.SF_Session.ExecuteCalcFunction("RANDBETWEEN", 1, 9999999)
- sRandom = "SF_" & Right("0000000" & lRandom, 7)
- oSheets.getByName(.SheetName).setName(sRandom)
- End If
- ' Import i.o. Copy
- oSheets.importSheet(oSheet.Component, .SheetName, lSheetIndex)
- ' Rename to new sheet name
- oSheets.getByName(.SheetName).setName(NewName)
- ' Reset random name
- If Len(sRandom) > 0 Then oSheets.getByName(srandom).setName(.SheetName)
- End With
- End If
- bCopy = True
- Finally:
- CopySheet = bCopy
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchDuplicate:
- ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, "NewName", NewName, "Document", [_Super]._FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CopySheet
- REM -----------------------------------------------------------------------------
- Public Function CopySheetFromFile(Optional ByVal FileName As Variant _
- , Optional ByVal SheetName As Variant _
- , Optional ByVal NewName As Variant _
- , Optional ByVal BeforeSheet As Variant _
- ) As Boolean
- ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets
- ''' The sheet to copy is located inside any closed Calc document
- ''' Args:
- ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
- ''' The file must not be protected with a password
- ''' SheetName: The name of the sheet to copy or its reference
- ''' NewName: Must not exist
- ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
- ''' Returns:
- ''' True if the sheet could be created
- ''' The created sheet is blank when the input file is not a Calc file
- ''' The created sheet contains an error message when the input sheet was not found
- ''' Exceptions:
- ''' DUPLICATESHEETERROR A sheet with the given name exists already
- ''' UNKNOWNFILEERROR The input file is unknown
- ''' Examples:
- ''' oDoc.CopySheetFromFile("C:\MyFile.ods", "SheetX", "SheetY", 3)
- Dim bCopy As Boolean ' Return value
- Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet
- Dim sFileName As String ' URL alias of FileName
- Dim FSO As Object ' SF_FileSystem
- Const cstThisSub = "SFDocuments.Calc.CopySheetFromFile"
- Const cstSubArgs = "FileName, SheetName, NewName, [BeforeSheet=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bCopy = False
- Check:
- If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SheetName, "SheetName", V_STRING) Then GoTo Finally
- If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally
- If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally
- End If
- Try:
- Set FSO = ScriptForge.SF_FileSystem
- ' Does the input file exist ?
- If Not FSO.FileExists(FileName) Then GoTo CatchNotExists
- sFileName = FSO._ConvertToUrl(FileName)
- ' Insert a blank new sheet and import sheet from file va link setting and deletion
- If Not InsertSheet(Newname, BeforeSheet) Then GoTo Finally
- Set oSheet = _Component.getSheets.getByName(NewName)
- With oSheet
- .link(sFileName,SheetName, "", "", com.sun.star.sheet.SheetLinkMode.NORMAL)
- .LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
- .LinkURL = ""
- End With
- bCopy = True
- Finally:
- CopySheetFromFile = bCopy
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchNotExists:
- ScriptForge.SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CopySheetFromFile
- REM -----------------------------------------------------------------------------
- Public Function CopyToCell(Optional ByVal SourceRange As Variant _
- , Optional ByVal DestinationCell As Variant _
- ) As String
- ''' Copy a specified source range to a destination range or cell
- ''' The source range may belong to another open document
- ''' The method imitates the behaviour of a Copy/Paste from a range to a single cell
- ''' Args:
- ''' SourceRange: the source range as a string if it belongs to the same document
- ''' or as a reference if it belongs to another open Calc document
- ''' DestinationCell: the destination of the copied range of cells, as a string
- ''' If given as range, the destination will be reduced to its top-left cell
- ''' Returns:
- ''' A string representing the modified range of cells
- ''' The modified area depends only on the size of the source area
- ''' Examples:
- ''' oDoc.CopyToCell("SheetX.A1:F10", "SheetY.C5")
- ''' ' Copy within the same document
- ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
- ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
- ''' oDocB.CopyToCell(oDocA.Range("SheetX.A1:F10"), "SheetY.C5")
- ''' ' Copy from 1 file to another
- Dim sCopy As String ' Return value
- Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error
- Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress
- Dim oDestRange As Object ' Destination as a range
- Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
- Dim oDestCell As Object ' com.sun.star.table.CellAddress
- Dim oSelect As Object ' Current selection in source
- Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
- Const cstThisSub = "SFDocuments.Calc.CopyToCell"
- Const cstSubArgs = "SourceRange, DestinationCell"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sCopy = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
- End If
- Try:
- If VarType(SourceRange) = V_STRING Then ' Same document - Use UNO copyRange method
- Set oSourceAddress = _ParseAddress(SourceRange).XCellRange.RangeAddress
- Set oDestRange = _ParseAddress(DestinationCell)
- Set oDestAddress = oDestRange.XCellRange.RangeAddress
- Set oDestCell = New com.sun.star.table.CellAddress
- With oDestAddress
- oDestCell.Sheet = .Sheet
- oDestCell.Column = .StartColumn
- oDestCell.Row = .StartRow
- End With
- oDestRange.XSpreadsheet.copyRange(oDestCell, oSourceAddress)
- Else ' Use clipboard to copy - current selection in Source should be preserved
- Set oSource = SourceRange
- With oSource
- ' Keep current selection in source document
- Set oSelect = .Component.CurrentController.getSelection()
- ' Select, copy the source range and paste in the top-left cell of the destination
- .Component.CurrentController.select(.XCellRange)
- Set oClipboard = .Component.CurrentController.getTransferable()
- _Component.CurrentController.select(_Offset(DestinationCell, 0, 0, 1, 1).XCellRange)
- _Component.CurrentController.insertTransferable(oClipBoard)
- ' Restore previous selection in Source
- _RestoreSelections(.Component, oSelect)
- Set oSourceAddress = .XCellRange.RangeAddress
- End With
- End If
- With oSourceAddress
- sCopy = _Offset(DestinationCell, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName
- End With
- Finally:
- CopyToCell = sCopy
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CopyToCell
- REM -----------------------------------------------------------------------------
- Public Function CopyToRange(Optional ByVal SourceRange As Variant _
- , Optional ByVal DestinationRange As Variant _
- ) As String
- ''' Copy downwards and/or rightwards a specified source range to a destination range
- ''' The source range may belong to another open document
- ''' The method imitates the behaviour of a Copy/Paste from a range to a larger range
- ''' If the height (resp. width) of the destination area is > 1 row (resp. column)
- ''' then the height (resp. width) of the source must be <= the height (resp. width)
- ''' of the destination. Otherwise nothing happens
- ''' If the height (resp.width) of the destination is = 1 then the destination
- ''' is expanded downwards (resp. rightwards) up to the height (resp. width)
- ''' of the source range
- ''' Args:
- ''' SourceRange: the source range as a string if it belongs to the same document
- ''' or as a reference if it belongs to another open Calc document
- ''' DestinationRange: the destination of the copied range of cells, as a string
- ''' Returns:
- ''' A string representing the modified range of cells
- ''' Examples:
- ''' oDoc.CopyToRange("SheetX.A1:F10", "SheetY.C5:J5")
- ''' ' Copy within the same document
- ''' ' Returned range: $SheetY.$C$5:$J$14
- ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
- ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
- ''' oDocB.CopyToRange(oDocA.Range("SheetX.A1:F10"), "SheetY.C5:J5")
- ''' ' Copy from 1 file to another
- Dim sCopy As String ' Return value
- Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error
- Dim oDestRange As Object ' Destination as a range
- Dim oDestCell As Object ' com.sun.star.table.CellAddress
- Dim oSelect As Object ' Current selection in source
- Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
- Dim bSameDocument As Boolean ' True when source in same document as destination
- Dim lHeight As Long ' Height of destination
- Dim lWidth As Long ' Width of destination
- Const cstThisSub = "SFDocuments.Calc.CopyToRange"
- Const cstSubArgs = "SourceRange, DestinationRange"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sCopy = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(DestinationRange, "DestinationRange", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Copy done via clipboard
- ' Check Height/Width destination = 1 or > Height/Width of source
- bSameDocument = ( VarType(SourceRange) = V_STRING )
- If bSameDocument Then Set oSource = _ParseAddress(SourceRange) Else Set oSource = SourceRange
- Set oDestRange = _ParseAddress(DestinationRange)
- With oDestRange
- lHeight = .Height
- lWidth = .Width
- If lHeight = 1 Then
- lHeight = oSource.Height ' Future height
- ElseIf lHeight < oSource.Height Then
- GoTo Finally
- End If
- If lWidth = 1 Then
- lWidth = oSource.Width ' Future width
- ElseIf lWidth < oSource.Width Then
- GoTo Finally
- End If
- End With
- With oSource
- ' Store actual selection in source
- Set oSelect = .Component.CurrentController.getSelection()
- ' Select, copy the source range and paste in the destination
- .Component.CurrentController.select(.XCellRange)
- Set oClipboard = .Component.CurrentController.getTransferable()
- _Component.CurrentController.select(oDestRange.XCellRange)
- _Component.CurrentController.insertTransferable(oClipBoard)
- ' Restore selection in source
- _RestoreSelections(.Component, oSelect)
- End With
-
- sCopy = _Offset(oDestRange, 0, 0, lHeight, lWidth).RangeName
- Finally:
- CopyToRange = sCopy
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CopyToRange
- REM -----------------------------------------------------------------------------
- Public Function DAvg(Optional ByVal Range As Variant) As Double
- ''' Get the average of the numeric values stored in the given range
- ''' Args:
- ''' Range : the range as a string where to get the values from
- ''' Returns:
- ''' The average of the numeric values as a double
- ''' Examples:
- ''' Val = oDoc.DAvg("~.A1:A1000")
- Try:
- DAvg = _DFunction("DAvg", Range)
- Finally:
- Exit Function
- End Function ' SF_Documents.SF_Calc.DAvg
- REM -----------------------------------------------------------------------------
- Public Function DCount(Optional ByVal Range As Variant) As Long
- ''' Get the number of numeric values stored in the given range
- ''' Args:
- ''' Range : the range as a string where to get the values from
- ''' Returns:
- ''' The number of numeric values a Long
- ''' Examples:
- ''' Val = oDoc.DCount("~.A1:A1000")
- Try:
- DCount = _DFunction("DCount", Range)
- Finally:
- Exit Function
- End Function ' SF_Documents.SF_Calc.DCount
- REM -----------------------------------------------------------------------------
- Public Function DMax(Optional ByVal Range As Variant) As Double
- ''' Get the greatest of the numeric values stored in the given range
- ''' Args:
- ''' Range : the range as a string where to get the values from
- ''' Returns:
- ''' The greatest of the numeric values as a double
- ''' Examples:
- ''' Val = oDoc.DMax("~.A1:A1000")
- Try:
- DMax = _DFunction("DMax", Range)
- Finally:
- Exit Function
- End Function ' SF_Documents.SF_Calc.DMax
- REM -----------------------------------------------------------------------------
- Public Function DMin(Optional ByVal Range As Variant) As Double
- ''' Get the smallest of the numeric values stored in the given range
- ''' Args:
- ''' Range : the range as a string where to get the values from
- ''' Returns:
- ''' The smallest of the numeric values as a double
- ''' Examples:
- ''' Val = oDoc.DMin("~.A1:A1000")
- Try:
- DMin = _DFunction("DMin", Range)
- Finally:
- Exit Function
- End Function ' SF_Documents.SF_Calc.DMin
- REM -----------------------------------------------------------------------------
- Public Function DSum(Optional ByVal Range As Variant) As Double
- ''' Get sum of the numeric values stored in the given range
- ''' Args:
- ''' Range : the range as a string where to get the values from
- ''' Returns:
- ''' The sum of the numeric values as a double
- ''' Examples:
- ''' Val = oDoc.DSum("~.A1:A1000")
- Try:
- DSum = _DFunction("DSum", Range)
- Finally:
- Exit Function
- End Function ' SF_Documents.SF_Calc.DSum
- REM -----------------------------------------------------------------------------
- Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String
- ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ').
- ''' Args:
- ''' ColumnNumber: the column number, must be in the interval 1 ... 1024
- ''' Returns:
- ''' a string representation of the column name, in range 'A'..'AMJ'
- ''' If ColumnNumber is not in the allowed range, returns a zero-length string
- ''' Example:
- ''' MsgBox oDoc.GetColumnName(1022) ' "AMH"
- ''' Adapted from a Python function by sundar nataraj
- ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter
- Dim sCol As String ' Return value
- Const cstThisSub = "SFDocuments.Calc.GetColumnName"
- Const cstSubArgs = "ColumnNumber"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sCol = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._Validate(ColumnNumber, "ColumnNumber", V_NUMERIC) Then GoTo Finally
- End If
- Try:
- If (ColumnNumber > 0) And (ColumnNumber <= MAXCOLS) Then sCol = _GetColumnName(ColumnNumber)
- Finally:
- GetColumnName = sCol
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.GetColumnName
- REM -----------------------------------------------------------------------------
- Public Function GetFormula(Optional ByVal Range As Variant) As Variant
- ''' Get the formula(e) stored in the given range of cells
- ''' Args:
- ''' Range : the range as a string where to get the formula from
- ''' Returns:
- ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings
- ''' Examples:
- ''' Val = oDoc.GetFormula("~.A1:A1000")
- Dim vGet As Variant ' Return value
- Dim oAddress As Object ' Alias of Range
- Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
- Const cstThisSub = "SFDocuments.Calc.GetFormula"
- Const cstSubArgs = "Range"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- vGet = Empty
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Get the data
- Set oAddress = _ParseAddress(Range)
- vDataArray = oAddress.XCellRange.getFormulaArray()
- ' Convert the data array to scalar, vector or array
- vGet = _ConvertFromDataArray(vDataArray)
- Finally:
- GetFormula = vGet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.GetFormula
- REM -----------------------------------------------------------------------------
- Public Function GetProperty(Optional ByVal PropertyName As Variant _
- , Optional ObjectName As Variant _
- ) As Variant
- ''' Return the actual value of the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' ObjectName: a sheet or range name
- ''' Returns:
- ''' The actual value of the property
- ''' Exceptions:
- ''' ARGUMENTERROR The property does not exist
- Const cstThisSub = "SFDocuments.Calc.GetProperty"
- Const cstSubArgs = ""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- GetProperty = Null
- Check:
- If IsMissing(ObjectName) Or IsEMpty(ObjectName) Then ObjectName = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- If Not ScriptForge.SF_Utils._Validate(ObjectName, "ObjectName", V_STRING) Then GoTo Catch
- End If
- Try:
- ' Superclass or subclass property ?
- If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then
- GetProperty = [_Super].GetProperty(PropertyName)
- Else
- GetProperty = _PropertyGet(PropertyName)
- End If
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.GetProperty
- REM -----------------------------------------------------------------------------
- Public Function GetValue(Optional ByVal Range As Variant) As Variant
- ''' Get the value(s) stored in the given range of cells
- ''' Args:
- ''' Range : the range as a string where to get the value from
- ''' Returns:
- ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and doubles
- ''' To convert doubles to dates, use the CDate builtin function
- ''' Examples:
- ''' Val = oDoc.GetValue("~.A1:A1000")
- Dim vGet As Variant ' Return value
- Dim oAddress As Object ' Alias of Range
- Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
- Const cstThisSub = "SFDocuments.Calc.GetValue"
- Const cstSubArgs = "Range"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- vGet = Empty
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Get the data
- Set oAddress = _ParseAddress(Range)
- vDataArray = oAddress.XCellRange.getDataArray()
- ' Convert the data array to scalar, vector or array
- vGet = _ConvertFromDataArray(vDataArray)
- Finally:
- GetValue = vGet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.GetValue
- REM -----------------------------------------------------------------------------
- Public Function ImportFromCSVFile(Optional ByVal FileName As Variant _
- , Optional ByVal DestinationCell As Variant _
- , Optional ByVal FilterOptions As Variant _
- ) As String
- ''' Import the content of a CSV-formatted text file starting from a given cell
- ''' Beforehand the destination area will be cleared from any content and format
- ''' Args:
- ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
- ''' DestinationCell: the destination of the copied range of cells, as a string
- ''' If given as range, the destination will be reduced to its top-left cell
- ''' FilterOptions: The arguments of the CSV input filter.
- ''' Read https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options#Filter_Options_for_the_CSV_Filter
- ''' Default: input file encoding is UTF8
- ''' separator = comma, semi-colon or tabulation
- ''' string delimiter = double quote
- ''' all lines are included
- ''' quoted strings are formatted as texts
- ''' special numbers are detected
- ''' all columns are presumed texts
- ''' language = english/US => decimal separator is ".", thousands separator = ","
- ''' Returns:
- ''' A string representing the modified range of cells
- ''' The modified area depends only on the content of the source file
- ''' Exceptions:
- ''' DOCUMENTOPENERROR The csv file could not be opened
- ''' Examples:
- ''' oDoc.ImportFromCSVFile("C:\Temp\myCsvFile.csv", "SheetY.C5")
- Dim sImport As String ' Return value
- Dim oUI As Object ' UI service
- Dim oSource As Object ' New Calc document with csv loaded
- Dim oSelect As Object ' Current selection in destination
- Const cstFilter = "Text - txt - csv (StarCalc)"
- Const cstFilterOptions = "9/44/59/MRG,34,76,1,,1033,true,true"
- Const cstThisSub = "SFDocuments.Calc.ImportFromCSVFile"
- Const cstSubArgs = "FileName, DestinationCell, [FilterOptions]=""9/44/59/MRG,34,76,1,,1033,true,true"""
- ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sImport = ""
- Check:
- If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = cstFilterOptions
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Input file is loaded in an empty worksheet. Data are copied to destination cell
- Set oUI = CreateScriptService("UI")
- Set oSource = oUI.OpenDocument(FileName _
- , ReadOnly := True _
- , Hidden := True _
- , FilterName := cstFilter _
- , FilterOptions := FilterOptions _
- )
- ' Remember current selection and restore it after copy
- Set oSelect = _Component.CurrentController.getSelection()
- sImport = CopyToCell(oSource.Range("*"), DestinationCell)
- _RestoreSelections(_Component, oSelect)
- Finally:
- If Not IsNull(oSource) Then oSource.CloseDocument(False)
- ImportFromCSVFile = sImport
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.ImportFromCSVFile
- REM -----------------------------------------------------------------------------
- Public Sub ImportFromDatabase(Optional ByVal FileName As Variant _
- , Optional ByVal RegistrationName As Variant _
- , Optional ByVal DestinationCell As Variant _
- , Optional ByVal SQLCommand As Variant _
- , Optional ByVal DirectSQL As Variant _
- )
- ''' Import the content of a database table, query or resultset, i.e. the result of a SELECT SQL command,
- ''' starting from a given cell
- ''' Beforehand the destination area will be cleared from any content and format
- ''' The modified area depends only on the content of the source data
- ''' Args:
- ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
- ''' RegistrationName: the name of a registered database
- ''' It is ignored if FileName <> ""
- ''' DestinationCell: the destination of the copied range of cells, as a string
- ''' If given as range, the destination will be reduced to its top-left cell
- ''' SQLCommand: either a table or query name (without square brackets)
- ''' or a full SQL commands where table and fieldnames are preferably surrounded with square brackets
- ''' Returns:
- ''' Implemented as a Sub because the doImport UNO method does not return any error
- ''' Exceptions:
- ''' BASEDOCUMENTOPENERROR The database file could not be opened
- ''' Examples:
- ''' oDoc.ImportFromDatabase("C:\Temp\myDbFile.odb", , "SheetY.C5", "SELECT * FROM [Employees] ORDER BY [LastName]")
- Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
- Dim oDatabase As Object ' SFDatabases.Database service
- Dim lCommandType As Long ' A com.sun.star.sheet.DataImportMode.xxx constant
- Dim oQuery As Object ' com.sun.star.ucb.XContent
- Dim bDirect As Boolean ' Alias of DirectSQL
- Dim oDestRange As Object ' Destination as a range
- Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
- Dim oDestCell As Object ' com.sun.star.table.XCell
- Dim oSelect As Object ' Current selection in destination
- Dim vImportOptions As Variant ' Array of PropertyValues
- Const cstThisSub = "SFDocuments.Calc.ImportFromDatabase"
- Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], DestinationCell, SQLCommand, [DirectSQL=False]"
- ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
-
- If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = ""
- If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
- If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally
- End If
- ' Check the existence of FileName
- If Len(FileName) = 0 Then ' FileName has precedence over RegistrationName
- If Len(RegistrationName) = 0 Then GoTo CatchError
- Set oDBContext = ScriptForge.SF_Utils._GetUNOService("DatabaseContext")
- If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError
- FileName = ScriptForge.SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName))
- End If
- If Not ScriptForge.SF_FileSystem.FileExists(FileName) Then GoTo CatchError
-
- Try:
- ' Check command type
- Set oDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database", FileName, , True) ' Read-only
- If IsNull(oDatabase) Then GoTo CatchError
- With oDatabase
- If ScriptForge.SF_Array.Contains(.Tables, SQLCommand) Then
- bDirect = True
- lCommandType = com.sun.star.sheet.DataImportMode.TABLE
- ElseIf ScriptForge.SF_Array.Contains(.Queries, SQLCommand) Then
- Set oQuery = .XConnection.Queries.getByName(SQLCommand)
- bDirect = Not oQuery.EscapeProcessing
- lCommandType = com.sun.star.sheet.DataImportMode.QUERY
- Else
- bDirect = DirectSQL
- lCommandType = com.sun.star.sheet.DataImportMode.SQL
- SQLCommand = ._ReplaceSquareBrackets(SQLCommand)
- End If
- .CloseDatabase()
- Set oDatabase = oDatabase.Dispose()
- End With
- ' Determine the destination cell as the top-left coordinates of the given range
- Set oDestRange = _ParseAddress(DestinationCell)
- Set oDestAddress = oDestRange.XCellRange.RangeAddress
- Set oDestCell = oDestRange.XSpreadsheet.getCellByPosition(oDestAddress.StartColumn, oDestAddress.StartRow)
- ' Remember current selection
- Set oSelect = _Component.CurrentController.getSelection()
- ' Import arguments
- vImportOptions = Array(_
- ScriptForge.SF_Utils._MakePropertyValue("DatabaseName", ScriptForge.SF_FileSystem._ConvertToUrl(FileName)) _
- , ScriptForge.SF_Utils._MakePropertyValue("SourceObject", SQLCommand) _
- , ScriptForge.SF_Utils._MakePropertyValue("SourceType", lCommandType) _
- , ScriptForge.SF_Utils._MakePropertyValue("IsNative", bDirect) _
- )
- oDestCell.doImport(vImportOptions)
- ' Restore selection after import_
- _RestoreSelections(_Component, oSelect)
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- CatchError:
- SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName)
- GoTo Finally
- End Sub ' SFDocuments.SF_Calc.ImportFromDatabase
- REM -----------------------------------------------------------------------------
- Public Function InsertSheet(Optional ByVal SheetName As Variant _
- , Optional ByVal BeforeSheet As Variant _
- ) As Boolean
- ''' Insert a new empty sheet before an existing sheet or at the end of the list of sheets
- ''' Args:
- ''' SheetName: The name of the new sheet
- ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
- ''' Returns:
- ''' True if the sheet could be inserted successfully
- ''' Examples:
- ''' oDoc.InsertSheet("SheetX", "SheetY")
- Dim bInsert As Boolean ' Return value
- Dim vSheets As Variant ' List of existing sheets
- Dim lSheetIndex As Long ' Index of a sheet
- Const cstThisSub = "SFDocuments.Calc.InsertSheet"
- Const cstSubArgs = "SheetName, [BeforeSheet=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bInsert = False
- Check:
- If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", True) Then GoTo Finally
- If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally
- End If
- vSheets = _Component.getSheets.getElementNames()
- Try:
- If VarType(BeforeSheet) = V_STRING Then
- lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
- Else
- lSheetIndex = BeforeSheet - 1
- If lSheetIndex < 0 Then lSheetIndex = 0
- If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1
- End If
- _Component.getSheets.insertNewByName(SheetName, lSheetIndex)
- bInsert = True
- Finally:
- InsertSheet = binsert
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.InsertSheet
- REM -----------------------------------------------------------------------------
- Public Function Methods() As Variant
- ''' Return the list of public methods of the Model service as an array
- Methods = Array( _
- "Activate" _
- , "ClearAll" _
- , "ClearFormats" _
- , "ClearValues" _
- , "CloseDocument" _
- , "CopySheet" _
- , "CopySheetFromFile" _
- , "CopyToCell" _
- , "CopyToRange" _
- , "DAvg" _
- , "DCount" _
- , "DMax" _
- , "DMin" _
- , "DSum" _
- , "GetColumnName" _
- , "GetFormula" _
- , "GetValue" _
- , "ImportFromCSVFile" _
- , "ImportFromDatabase" _
- , "InsertSheet" _
- , "MoveRange" _
- , "MoveSheet" _
- , "Offset" _
- , "RemoveSheet" _
- , "RenameSheet" _
- , "RunCommand" _
- , "Save" _
- , "SaveAs" _
- , "SaveCopyAs" _
- , "SetArray" _
- , "SetCellStyle" _
- , "SetFormula" _
- , "SetValue" _
- , "SortRange" _
- )
- End Function ' SFDocuments.SF_Calc.Methods
- REM -----------------------------------------------------------------------------
- Public Function MoveRange(Optional ByVal Source As Variant _
- , Optional ByVal Destination As Variant _
- ) As String
- ''' Move a specified source range to a destination range
- ''' Args:
- ''' Source: the source range of cells as a string
- ''' Destination: the destination of the moved range of cells, as a string
- ''' Returns:
- ''' A string representing the modified range of cells
- ''' The modified area depends only on the size of the source area
- ''' Examples:
- ''' oDoc.MoveRange("SheetX.A1:F10", "SheetY.C5")
- Dim sMove As String ' Return value
- Dim oSource As Object ' Alias of Source to avoid "Object variable not set" run-time error
- Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress
- Dim oDestRange As Object ' Destination as a range
- Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
- Dim oDestCell As Object ' com.sun.star.table.CellAddress
- Dim oSelect As Object ' Current selection in source
- Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
- Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
- Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
- Dim i As Long
- Const cstThisSub = "SFDocuments.Calc.MoveRange"
- Const cstSubArgs = "Source, Destination"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sMove = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not _Validate(Source, "Source", V_STRING) Then GoTo Finally
- If Not _Validate(Destination, "Destination", V_STRING) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Source).XCellRange.RangeAddress
- Set oDestRange = _ParseAddress(Destination)
- Set oDestAddress = oDestRange.XCellRange.RangeAddress
- Set oDestCell = New com.sun.star.table.CellAddress
- With oDestAddress
- oDestCell.Sheet = .Sheet
- oDestCell.Column = .StartColumn
- oDestCell.Row = .StartRow
- End With
- oDestRange.XSpreadsheet.moveRange(oDestCell, oSourceAddress)
- With oSourceAddress
- sMove = _Offset(Destination, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName
- End With
- Finally:
- MoveRange = sMove
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.MoveRange
- REM -----------------------------------------------------------------------------
- Public Function MoveSheet(Optional ByVal SheetName As Variant _
- , Optional ByVal BeforeSheet As Variant _
- ) As Boolean
- ''' Move a sheet before an existing sheet or at the end of the list of sheets
- ''' Args:
- ''' SheetName: The name of the sheet to move
- ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to move the sheet
- ''' Returns:
- ''' True if the sheet could be moved successfully
- ''' Examples:
- ''' oDoc.MoveSheet("SheetX", "SheetY")
- Dim bMove As Boolean ' Return value
- Dim vSheets As Variant ' List of existing sheets
- Dim lSheetIndex As Long ' Index of a sheet
- Const cstThisSub = "SFDocuments.Calc.MoveSheet"
- Const cstSubArgs = "SheetName, [BeforeSheet=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bMove = False
- Check:
- If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
- If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally
- End If
- vSheets = _Component.getSheets.getElementNames()
- Try:
- If VarType(BeforeSheet) = V_STRING Then
- lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
- Else
- lSheetIndex = BeforeSheet - 1
- If lSheetIndex < 0 Then lSheetIndex = 0
- If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1
- End If
- _Component.getSheets.MoveByName(SheetName, lSheetIndex)
- bMove = True
- Finally:
- MoveSheet = bMove
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.MoveSheet
- REM -----------------------------------------------------------------------------
- Public Function Offset(Optional ByRef Range As Variant _
- , Optional ByVal Rows As Variant _
- , Optional ByVal Columns As Variant _
- , Optional ByVal Height As Variant _
- , Optional ByVal Width As Variant _
- ) As String
- ''' Returns a new range offset by a certain number of rows and columns from a given range
- ''' Args:
- ''' Range : the range, as a string, from which the function searches for the new range
- ''' Rows : the number of rows by which the reference was corrected up (negative value) or down.
- ''' Use 0 (default) to stay in the same row.
- ''' Columns : the number of columns by which the reference was corrected to the left (negative value) or to the right.
- ''' Use 0 (default) to stay in the same column
- ''' Height : the vertical height for an area that starts at the new reference position.
- ''' Default = no vertical resizing
- ''' Width : the horizontal width for an area that starts at the new reference position.
- ''' Default - no horizontal resizing
- ''' Arguments Rows and Columns must not lead to zero or negative start row or column.
- ''' Arguments Height and Width must not lead to zero or negative count of rows or columns.
- ''' Returns:
- ''' A new range as a string
- ''' Exceptions:
- ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
- ''' Examples:
- ''' oDoc.Offset("A1", 2, 2) ' "'SheetX'.$C$3" (A1 moved by two rows and two columns down)
- ''' oDoc.Offset("A1", 2, 2, 5, 6) ' "'SheetX'.$C$3:$H$7"
- Dim sOffset As String ' Return value
- Dim oAddress As Object ' Alias of Range
- Const cstThisSub = "SFDocuments.Calc.Offset"
- Const cstSubArgs = "Range, [Rows=0], [Columns=0], [Height], [Width]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sOffset = ""
- Check:
- If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
- If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
- If IsMissing(Height) Or IsEmpty(Height) Then Height = 0
- If IsMissing(Width) Or IsEmpty(Width) Then Width = 0
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- ' Define the new range string
- Set oAddress = _Offset(Range, Rows, Columns, Height, Width)
- sOffset = oAddress.RangeName
- Finally:
- Offset = sOffset
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.Offset
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the Timer class as an array
- Properties = Array( _
- "CurrentSelection" _
- , "CustomProperties" _
- , "Description" _
- , "DocumentProperties" _
- , "DocumentType" _
- , "Height" _
- , "IsBase" _
- , "IsCalc" _
- , "IsDraw " _
- , "IsImpress" _
- , "IsMath" _
- , "IsWriter" _
- , "Keywords" _
- , "LastCell" _
- , "LastColumn" _
- , "LastRow" _
- , "Range" _
- , "Readonly" _
- , "Sheet" _
- , "Sheets" _
- , "Subject" _
- , "Title" _
- , "Width" _
- , "XCellRange" _
- , "XComponent" _
- , "XSpreadsheet" _
- )
- End Function ' SFDocuments.SF_Calc.Properties
- REM -----------------------------------------------------------------------------
- Public Function RemoveSheet(Optional ByVal SheetName As Variant) As Boolean
- ''' Remove an existing sheet from the document
- ''' Args:
- ''' SheetName: The name of the sheet to remove
- ''' Returns:
- ''' True if the sheet could be removed successfully
- ''' Examples:
- ''' oDoc.RemoveSheet("SheetX")
- Dim bRemove As Boolean ' Return value
- Const cstThisSub = "SFDocuments.Calc.RemoveSheet"
- Const cstSubArgs = "SheetName"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bRemove = False
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
- End If
- Try:
- _Component.getSheets.RemoveByName(SheetName)
- bRemove = True
- Finally:
- RemoveSheet = bRemove
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.RemoveSheet
- REM -----------------------------------------------------------------------------
- Public Function RenameSheet(Optional ByVal SheetName As Variant _
- , Optional ByVal NewName As Variant _
- ) As Boolean
- ''' Rename a specified sheet
- ''' Args:
- ''' SheetName: The name of the sheet to rename
- ''' NewName: Must not exist
- ''' Returns:
- ''' True if the sheet could be renamed successfully
- ''' Exceptions:
- ''' DUPLICATESHEETERROR A sheet with the given name exists already
- ''' Examples:
- ''' oDoc.RenameSheet("SheetX", "SheetY")
- Dim bRename As Boolean ' Return value
- Const cstThisSub = "SFDocuments.Calc.RenameSheet"
- Const cstSubArgs = "SheetName, NewName"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bRename = False
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive(True) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
- If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally
- End If
- Try:
- _Component.getSheets.getByName(SheetName).setName(NewName)
- bRename = True
- Finally:
- RenameSheet = bRename
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.RenameSheet
- REM -----------------------------------------------------------------------------
- Public Function SetArray(Optional ByVal TargetCell As Variant _
- , Optional ByRef Value As Variant _
- ) As String
- ''' Set the given (array of) values starting from the target cell
- ''' The updated area expands itself from the target cell or from the top-left corner of the given range
- ''' as far as determined by the size of the input Value.
- ''' Vectors are always expanded vertically
- ''' Args:
- ''' TargetCell : the cell or the range as a string that should receive a new value
- ''' Value: a scalar, a vector or an array with the new values
- ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell
- ''' Returns:
- ''' A string representing the updated range
- ''' Exceptions:
- ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
- ''' Examples:
- ''' oDoc.SetArray("SheetX.A1", SF_Array.RangeInit(1, 1000))
- Dim sSet As String ' Return value
- Dim oSet As Object ' _Address alias of sSet
- Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
- Const cstThisSub = "SFDocuments.Calc.SetArray"
- Const cstSubArgs = "TargetCell, Value"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSet = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
- If IsArray(Value) Then
- If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(Value, "Value") Then GoTo Finally
- End If
- End If
- Try:
- ' Convert argument to data array and derive new range from its size
- vDataArray = _ConvertToDataArray(Value)
- If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
- Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based
- With oSet
- .XCellRange.setDataArray(vDataArray)
- sSet = .RangeName
- End With
- Finally:
- SetArray = sSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.SetArray
- REM -----------------------------------------------------------------------------
- Public Function SetCellStyle(Optional ByVal TargetRange As Variant _
- , Optional ByVal Style As Variant _
- ) As String
- ''' Apply the given cell style in the given range
- ''' The full range is updated and the remainder of the sheet is left untouched
- ''' If the cell style does not exist, an error is raised
- ''' Args:
- ''' TargetRange : the range as a string that should receive a new cell style
- ''' Style: the style name as a string
- ''' Returns:
- ''' A string representing the updated range
- ''' Examples:
- ''' oDoc.SetCellStyle("A1:F1", "Heading 2")
- Dim sSet As String ' Return value
- Dim oAddress As _Address ' Alias of TargetRange
- Dim oStyleFamilies As Object ' com.sun.star.container.XNameAccess
- Dim vStyles As Variant ' Array of existing cell styles
- Const cstStyle = "CellStyles"
- Const cstThisSub = "SFDocuments.Calc.SetCellStyle"
- Const cstSubArgs = "TargetRange, Style"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSet = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally
- Set oStyleFamilies = _Component.StyleFamilies
- If oStyleFamilies.hasByName(cstStyle) Then vStyles = oStyleFamilies.getByName(cstStyle).getElementNames() Else vStyles = Array()
- If Not ScriptForge.SF_Utils._Validate(Style, "Style", V_STRING, vStyles) Then GoTo Finally
- End If
- Try:
- Set oAddress = _ParseAddress(TargetRange)
- With oAddress
- .XCellRange.CellStyle = Style
- sSet = .RangeName
- End With
- Finally:
- SetCellStyle = sSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.SetCellStyle
- REM -----------------------------------------------------------------------------
- Public Function SetFormula(Optional ByVal TargetRange As Variant _
- , Optional ByRef Formula As Variant _
- ) As String
- ''' Set the given (array of) formulae in the given range
- ''' The full range is updated and the remainder of the sheet is left untouched
- ''' If the given formula is a string:
- ''' the unique formula is pasted across the whole range with adjustment of the relative references
- ''' Otherwise
- ''' If the size of Formula < the size of Range, then the other cells are emptied
- ''' If the size of Formula > the size of Range, then Formula is only partially copied
- ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row
- ''' Args:
- ''' TargetRange : the range as a string that should receive a new Formula
- ''' Formula: a scalar, a vector or an array with the new formula(e) as strings for each cell of the range.
- ''' Returns:
- ''' A string representing the updated range
- ''' Examples:
- ''' oDoc.SetFormula("A1", "=A2")
- ''' oDoc.SetFormula("A1:F1", Array("=A2", "=B2", "=C2+10")) ' Horizontal vector, partially empty
- ''' oDoc.SetFormula("A1:D2", "=E1") ' D2 contains the formula "=H2"
- Dim sSet As String ' Return value
- Dim oAddress As Object ' Alias of TargetRange
- Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
- Const cstThisSub = "SFDocuments.Calc.SetFormula"
- Const cstSubArgs = "TargetRange, Formula"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSet = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally
- If IsArray(Formula) Then
- If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(Formula, "Formula", V_STRING) Then GoTo Finally
- End If
- End If
- Try:
- Set oAddress = _ParseAddress(TargetRange)
- With oAddress
- If IsArray(Formula) Then
- ' Convert to data array and limit its size to the size of the initial range
- vDataArray = _ConvertToDataArray(Formula, .Height - 1, .Width - 1)
- If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
- .XCellRange.setFormulaArray(vDataArray)
- Else
- With .XCellRange
- ' Store formula in top-left cell and paste it along the whole range
- .getCellByPosition(0, 0).setFormula(Formula)
- .fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0)
- .fillSeries(com.sun.star.sheet.FillDirection.TO_RIGHT, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0)
- End With
- End If
- sSet = .RangeName
- End With
- Finally:
- SetFormula = sSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.SetFormula
- REM -----------------------------------------------------------------------------
- Private Function SetProperty(Optional ByVal psProperty As String _
- , Optional ByVal pvValue As Variant _
- ) As Boolean
- ''' Set the new value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- ''' pvValue: the new value of the given property
- ''' Returns:
- ''' True if successful
- Dim bSet As Boolean ' Return value
- Static oSession As Object ' Alias of SF_Session
- Dim cstThisSub As String
- Const cstSubArgs = "Value"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bSet = False
- cstThisSub = "SFDocuments.Calc.set" & psProperty
- If IsMissing(pvValue) Then pvValue = Empty
- 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
- If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
- bSet = True
- Select Case UCase(psProperty)
- Case UCase("CurrentSelection")
- CurrentSelection = pvValue
- Case UCase("CustomProperties")
- CustomProperties = pvValue
- Case UCase("Description")
- Description = pvValue
- Case UCase("Keywords")
- Keywords = pvValue
- Case UCase("Subject")
- Subject = pvValue
- Case UCase("Title")
- Title = pvValue
- Case Else
- bSet = False
- End Select
- Finally:
- SetProperty = bSet
- 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.SetProperty
- REM -----------------------------------------------------------------------------
- Public Function SetValue(Optional ByVal TargetRange As Variant _
- , Optional ByRef Value As Variant _
- ) As String
- ''' Set the given value in the given range
- ''' The full range is updated and the remainder of the sheet is left untouched
- ''' If the size of Value < the size of Range, then the other cells are emptied
- ''' If the size of Value > the size of Range, then Value is only partially copied
- ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row
- ''' Args:
- ''' TargetRange : the range as a string that should receive a new value
- ''' Value: a scalar, a vector or an array with the new values for each cell of the range.
- ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell
- ''' Returns:
- ''' A string representing the updated range
- ''' Examples:
- ''' oDoc.SetValue("A1", 2)
- ''' oDoc.SetValue("A1:F1", Array(1, 2, 3)) ' Horizontal vector, partially empty
- ''' oDoc.SetValue("A1:D2", SF_Array.AppendRow(Array(1, 2, 3, 4), Array(5, 6, 7, 8)))
- Dim sSet As String ' Return value
- Dim oAddress As Object ' Alias of TargetRange
- Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
- Const cstThisSub = "SFDocuments.Calc.SetValue"
- Const cstSubArgs = "TargetRange, Value"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSet = ""
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally
- If IsArray(Value) Then
- If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(Value, "Value") Then GoTo Finally
- End If
- End If
- Try:
- Set oAddress = _ParseAddress(TargetRange)
- With oAddress
- ' Convert to data array and limit its size to the size of the initial range
- vDataArray = _ConvertToDataArray(Value, .Height - 1, .Width - 1)
- If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
- .XCellRange.setDataArray(vDataArray)
- sSet = .RangeName
- End With
- Finally:
- SetValue = sSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.SetValue
- REM -----------------------------------------------------------------------------
- Public Function SortRange(Optional ByVal Range As Variant _
- , Optional ByVal SortKeys As Variant _
- , Optional ByVal SortOrder As Variant _
- , Optional ByVal DestinationCell As Variant _
- , Optional ByVal ContainsHeader As Variant _
- , Optional ByVal CaseSensitive As Variant _
- , Optional ByVal SortColumns As Variant _
- ) As Variant
- ''' Sort the given range on maximum 3 columns/rows. The sorting order may vary by column/row
- ''' Args:
- ''' Range: the range to sort as a string
- ''' SortKeys: a scalar (if 1 column/row) or an array of column/row numbers starting from 1
- ''' SortOrder: a scalar or an array of strings: "ASC" or "DESC"
- ''' Each item is paired with the corresponding item in SortKeys
- ''' If the SortOrder array is shorter than SortKeys, the remaining keys are sorted
- ''' in ascending order
- ''' DestinationCell: the destination of the sorted range of cells, as a string
- ''' If given as range, the destination will be reduced to its top-left cell
- ''' By default, Range is overwritten with its sorted content
- ''' ContainsHeader: when True, the first row/column is not sorted
- ''' CaseSensitive: only for string comparisons, default = False
- ''' SortColumns: when True, the columns are sorted from left to right
- ''' Default = False: rows are sorted from top to bottom.
- ''' Returns:
- ''' The modified range of cells as a string
- ''' Example:
- ''' oDoc.SortRange("A2:J200", Array(1, 3), , Array("ASC", "DESC"), CaseSensitive := True)
- ''' ' Sort on columns A (ascending) and C (descending)
- Dim sSort As String ' Return value
- Dim oRangeAddress As _Address ' Parsed range
- Dim oRange As Object ' com.sun.star.table.XCellRange
- Dim oDestRange As Object ' Destination as a range
- Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
- Dim oDestCell As Object ' com.sun.star.table.CellAddress
- Dim vSortDescriptor As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim vSortFields As Variant ' Array of com.sun.star.table.TableSortField
- Dim sOrder As String ' Item in SortOrder
- Dim i As Long
- Const cstThisSub = "SFDocuments.Calc.SortRange"
- Const cstSubArgs = "Range, SortKeys, [TargetRange=""""], [SortOrder=""ASC""], [ContainsHeader=False], [CaseSensitive=False], [SortColumns=False]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSort = ""
- Check:
- If IsMissing(SortKeys) Or IsEmpty(SortKeys) Then
- SortKeys = Array(1)
- ElseIf Not IsArray(SortKeys) Then
- SortKeys = Array(SortKeys)
- End If
- If IsMissing(DestinationCell) Or IsEmpty(DestinationCell) Then DestinationCell = ""
- If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then
- SortOrder = Array("ASC")
- ElseIf Not IsArray(SortOrder) Then
- SortOrder = Array(SortOrder)
- End If
- If IsMissing(ContainsHeader) Or IsEmpty(ContainsHeader) Then ContainsHeader = False
- If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
- If IsMissing(SortColumns) Or IsEmpty(SortColumns) Then SortColumns = False
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._ValidateArray(SortOrder, "SortOrder", 1, V_STRING, True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", V_BOOLEAN) Then GoTo Finally
- End If
- Set oRangeAddress = _ParseAddress(Range)
- If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell)
- Try:
- ' Initialize the sort descriptor
- Set oRange = oRangeAddress.XCellRange
- vSortDescriptor = oRange.createSortDescriptor
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
- If Len(DestinationCell) = 0 Then
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False)
- Else
- Set oDestAddress = oDestRange.XCellRange.RangeAddress
- Set oDestCell = New com.sun.star.table.CellAddress
- With oDestAddress
- oDestCell.Sheet = .Sheet
- oDestCell.Column = .StartColumn
- oDestCell.Row = .StartRow
- End With
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", true)
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
- End If
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False)
- ' Define the sorting keys
- vSortFields = Array()
- ReDim vSortFields(0 To UBound(SortKeys))
- For i = 0 To UBound(SortKeys)
- vSortFields(i) = New com.sun.star.table.TableSortField
- If i > UBound(SortOrder) Then sOrder = "" Else sOrder = SortOrder(i)
- If Len(sOrder) = 0 Then sOrder = "ASC"
- With vSortFields(i)
- .Field = SortKeys(i) - 1
- .IsAscending = ( UCase(sOrder) = "ASC" )
- .IsCaseSensitive = CaseSensitive
- End With
- Next i
- ' Associate the keys and the descriptor, and sort
- ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields)
- oRange.sort(vSortDescriptor)
- ' Compute the changed area
- If Len(DestinationCell) = 0 Then
- sSort = oRangeAddress.RangeName
- Else
- With oRangeAddress
- sSort = _Offset(oDestRange, 0, 0, .Height, .Width).RangeName
- End With
- End If
- Finally:
- SortRange = sSort
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc.SortRange
- REM ======================================================= SUPERCLASS PROPERTIES
- REM -----------------------------------------------------------------------------
- Property Get CustomProperties() As Variant
- CustomProperties = [_Super].GetProperty("CustomProperties")
- End Property ' SFDocuments.SF_Calc.CustomProperties
- REM -----------------------------------------------------------------------------
- Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
- [_Super].CustomProperties = pvCustomProperties
- End Property ' SFDocuments.SF_Calc.CustomProperties
- REM -----------------------------------------------------------------------------
- Property Get Description() As Variant
- Description = [_Super].GetProperty("Description")
- End Property ' SFDocuments.SF_Calc.Description
- REM -----------------------------------------------------------------------------
- Property Let Description(Optional ByVal pvDescription As Variant)
- [_Super].Description = pvDescription
- End Property ' SFDocuments.SF_Calc.Description
- REM -----------------------------------------------------------------------------
- Property Get DocumentProperties() As Variant
- DocumentProperties = [_Super].GetProperty("DocumentProperties")
- End Property ' SFDocuments.SF_Calc.DocumentProperties
- REM -----------------------------------------------------------------------------
- Property Get DocumentType() As String
- DocumentType = [_Super].GetProperty("DocumentType")
- End Property ' SFDocuments.SF_Calc.DocumentType
- REM -----------------------------------------------------------------------------
- Property Get IsBase() As Boolean
- IsBase = [_Super].GetProperty("IsBase")
- End Property ' SFDocuments.SF_Calc.IsBase
- REM -----------------------------------------------------------------------------
- Property Get IsCalc() As Boolean
- IsCalc = [_Super].GetProperty("IsCalc")
- End Property ' SFDocuments.SF_Calc.IsCalc
- REM -----------------------------------------------------------------------------
- Property Get IsDraw() As Boolean
- IsDraw = [_Super].GetProperty("IsDraw")
- End Property ' SFDocuments.SF_Calc.IsDraw
- REM -----------------------------------------------------------------------------
- Property Get IsImpress() As Boolean
- IsImpress = [_Super].GetProperty("IsImpress")
- End Property ' SFDocuments.SF_Calc.IsImpress
- REM -----------------------------------------------------------------------------
- Property Get IsMath() As Boolean
- IsMath = [_Super].GetProperty("IsMath")
- End Property ' SFDocuments.SF_Calc.IsMath
- REM -----------------------------------------------------------------------------
- Property Get IsWriter() As Boolean
- IsWriter = [_Super].GetProperty("IsWriter")
- End Property ' SFDocuments.SF_Calc.IsWriter
- REM -----------------------------------------------------------------------------
- Property Get Keywords() As Variant
- Keywords = [_Super].GetProperty("Keywords")
- End Property ' SFDocuments.SF_Calc.Keywords
- REM -----------------------------------------------------------------------------
- Property Let Keywords(Optional ByVal pvKeywords As Variant)
- [_Super].Keywords = pvKeywords
- End Property ' SFDocuments.SF_Calc.Keywords
- REM -----------------------------------------------------------------------------
- Property Get Readonly() As Variant
- Readonly = [_Super].GetProperty("Readonly")
- End Property ' SFDocuments.SF_Calc.Readonly
- REM -----------------------------------------------------------------------------
- Property Get Subject() As Variant
- Subject = [_Super].GetProperty("Subject")
- End Property ' SFDocuments.SF_Calc.Subject
- REM -----------------------------------------------------------------------------
- Property Let Subject(Optional ByVal pvSubject As Variant)
- [_Super].Subject = pvSubject
- End Property ' SFDocuments.SF_Calc.Subject
- REM -----------------------------------------------------------------------------
- Property Get Title() As Variant
- Title = [_Super].GetProperty("Title")
- End Property ' SFDocuments.SF_Calc.Title
- REM -----------------------------------------------------------------------------
- Property Let Title(Optional ByVal pvTitle As Variant)
- [_Super].Title = pvTitle
- End Property ' SFDocuments.SF_Calc.Title
- REM -----------------------------------------------------------------------------
- Property Get XComponent() As Variant
- XComponent = [_Super].GetProperty("XComponent")
- End Property ' SFDocuments.SF_Calc.XComponent
- REM ========================================================== SUPERCLASS METHODS
- REM -----------------------------------------------------------------------------
- 'Public Function Activate() As Boolean
- ' Activate = [_Super].Activate()
- 'End Function ' SFDocuments.SF_Calc.Activate
- REM -----------------------------------------------------------------------------
- Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
- CloseDocument = [_Super].CloseDocument(SaveAsk)
- End Function ' SFDocuments.SF_Calc.CloseDocument
- REM -----------------------------------------------------------------------------
- Public Sub RunCommand(Optional ByVal Command As Variant)
- [_Super].RunCommand(Command)
- End Sub ' SFDocuments.SF_Calc.RunCommand
- REM -----------------------------------------------------------------------------
- Public Function Save() As Boolean
- Save = [_Super].Save()
- End Function ' SFDocuments.SF_Calc.Save
- REM -----------------------------------------------------------------------------
- Public Function SaveAs(Optional ByVal FileName As Variant _
- , Optional ByVal Overwrite As Variant _
- , Optional ByVal Password As Variant _
- , Optional ByVal FilterName As Variant _
- , Optional ByVal FilterOptions As Variant _
- ) As Boolean
- SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions)
- End Function ' SFDocuments.SF_Calc.SaveAs
- REM -----------------------------------------------------------------------------
- Public Function SaveCopyAs(Optional ByVal FileName As Variant _
- , Optional ByVal Overwrite As Variant _
- , Optional ByVal Password As Variant _
- , Optional ByVal FilterName As Variant _
- , Optional ByVal FilterOptions As Variant _
- ) As Boolean
- SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions)
- End Function ' SFDocuments.SF_Calc.SaveCopyAs
- REM =========================================================== PRIVATE FUNCTIONS
- REM -----------------------------------------------------------------------------
- Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant
- ''' Convert a data array to a scalar, a vector or a 2D array
- ''' Args:
- ''' pvDataArray: an array as returned by the XCellRange.getDataArray or .getFormulaArray methods
- ''' Returns:
- ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles
- ''' To convert doubles to dates, use the CDate builtin function
- Dim vArray As Variant ' Return value
- Dim lMax1 As Long ' UBound of pvDataArray
- Dim lMax2 As Long ' UBound of pvDataArray items
- Dim i As Long
- Dim j As Long
- vArray = Empty
- Try:
- ' Convert the data array to scalar, vector or array
- lMax1 = UBound(pvDataArray)
- If lMax1 >= 0 Then
- lMax2 = UBound(pvDataArray(0))
- If lMax2 >= 0 Then
- If lMax1 + lMax2 > 0 Then vArray = Array()
- Select Case True
- Case lMax1 = 0 And lMax2 = 0 ' Scalar
- vArray = pvDataArray(0)(0)
- Case lMax1 > 0 And lMax2 = 0 ' Vertical vector
- ReDim vArray(0 To lMax1)
- For i = 0 To lMax1
- vArray(i) = pvDataArray(i)(0)
- Next i
- Case lMax1 = 0 And lMax2 > 0 ' Horizontal vector
- ReDim vArray(0 To lMax2)
- For j = 0 To lMax2
- vArray(j) = pvDataArray(0)(j)
- Next j
- Case Else ' Array
- ReDim vArray(0 To lMax1, 0 To lMax2)
- For i = 0 To lMax1
- For j = 0 To lMax2
- vArray(i, j) = pvDataArray(i)(j)
- Next j
- Next i
- End Select
- End If
- End If
- Finally:
- _ConvertFromDataArray = vArray
- End Function ' SF_Documents.SF_Calc._ConvertFromDataArray
- REM -----------------------------------------------------------------------------
- Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant
- ''' Convert the argument to a valid Calc cell content
- Dim vCell As Variant ' Return value
- Try:
- Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem)
- Case V_STRING : vCell = pvItem
- Case V_DATE : vCell = CDbl(pvItem)
- Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem)
- Case ScriptForge.V_BOOLEAN : vCell = CDbl(Iif(pvItem, 1, 0))
- Case Else : vCell = ""
- End Select
- Finally:
- _ConvertToCellValue = vCell
- Exit Function
- End Function ' SF_Documents.SF_Calc._ConvertToCellValue
- REM -----------------------------------------------------------------------------
- Private Function _ConvertToDataArray(ByRef pvArray As Variant _
- , Optional ByVal plRows As Long _
- , Optional ByVal plColumns As Long _
- ) As Variant
- ''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property)
- ''' from a scalar, a 1D array or a 2D array
- ''' Array items are converted to (possibly empty) strings or doubles
- ''' Args:
- ''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored.
- ''' plRows, plColumns: the upper bounds of the data array
- ''' If bigger than input array, fill with zero-length strings
- ''' If smaller than input array, truncate
- ''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally
- ''' They are either both present or both absent
- ''' When absent
- ''' The size of the output is fully determined by the input array
- ''' Vectors are aligned vertically
- ''' Returns:
- ''' A data array compatible with ranges .DataArray property
- ''' The output is always an array of nested arrays
- Dim vDataArray() As Variant ' Return value
- Dim vVector() As Variant ' A temporary 1D array
- Dim vItem As Variant ' A single input item
- Dim iDims As Integer ' Number of dimensions of the input argument
- Dim lMin1 As Long ' Lower bound of input array
- Dim lMax1 As Long ' Upper bound
- Dim lMin2 As Long ' Lower bound
- Dim lMax2 As Long ' Upper bound
- Dim lRows As Long ' Upper bound of vDataArray
- Dim lCols As Long ' Upper bound of vVector
- Dim bHorizontal As Boolean ' Horizontal vector
- Dim i As Long
- Dim j As Long
- Const cstEmpty = "" ' Empty cell
- If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1
- If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1
- vDataArray = Array()
- Try:
- ' Check the input argument and know its boundaries
- iDims = ScriptForge.SF_Array.CountDims(pvArray)
- If iDims = 0 Or iDims > 2 Then Exit Function
- lMin1 = 0 : lMax1 = 0 ' Default values
- lMin2 = 0 : lMax2 = 0
- Select Case iDims
- Case -1 ' Scalar value
- Case 1
- bHorizontal = ( plRows = 0 And plColumns > 0)
- If Not bHorizontal Then
- lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
- Else
- lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray)
- End If
- Case 2
- lMin1 = LBound(pvArray, 1) : lMax1 = UBound(pvArray, 1)
- lMin2 = LBound(pvArray, 2) : lMax2 = UBound(pvArray, 2)
- End Select
- ' Set the output dimensions accordingly
- If plRows >= 0 Then ' Dimensions of output are imposed
- lRows = plRows
- lCols = plColumns
- Else ' Dimensions of output determined by input argument
- lRows = 0 : lCols = 0 ' Default values
- Select Case iDims
- Case -1 ' Scalar value
- Case 1 ' Vectors are aligned vertically
- lRows = lMax1 - lMin1
- Case 2
- lRows = lMax1 - lMin1
- lCols = lMax2 - lMin2
- End Select
- End If
- ReDim vDataArray(0 To lRows)
-
- ' Feed the output array row by row, each row being a vector
- For i = 0 To lRows
- ReDim vVector(0 To lCols)
- For j = 0 To lCols
- If i > lMax1 - lMin1 Then
- vVector(j) = cstEmpty
- ElseIf j > lMax2 - lMin2 Then
- vVector(j) = cstEmpty
- Else
- Select Case iDims
- Case -1 : vItem = _ConvertToCellValue(pvArray)
- Case 1
- If bHorizontal Then
- vItem = _ConvertToCellValue(pvArray(j + lMin2))
- Else
- vItem = _ConvertToCellValue(pvArray(i + lMin1))
- End If
- Case 2
- vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2))
- End Select
- vVector(j) = vItem
- End If
- vDataArray(i) = vVector
- Next j
- Next i
- Finally:
- _ConvertToDataArray = vDataArray
- Exit Function
- End Function ' SF_Documents.SF_Calc._ConvertToDataArray
- REM -----------------------------------------------------------------------------
- Private Function _DFunction(ByVal psFunction As String _
- , Optional ByVal Range As Variant _
- ) As Double
- ''' Apply the given function on all the numeric values stored in the given range
- ''' Args:
- ''' Range : the range as a string where to apply the function on
- ''' Returns:
- ''' The resulting value as a double
- Dim dblGet As Double ' Return value
- Dim oAddress As Object ' Alias of Range
- Dim vFunction As Variant ' com.sun.star.sheet.GeneralFunction.XXX
- Dim cstThisSub As String : cstThisSub = "SFDocuments.Calc." & psFunction
- Const cstSubArgs = "Range"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- dblGet = 0
- Check:
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Get the data
- Set oAddress = _ParseAddress(Range)
- Select Case psFunction
- Case "DAvg" : vFunction = com.sun.star.sheet.GeneralFunction.AVERAGE
- Case "DCount" : vFunction = com.sun.star.sheet.GeneralFunction.COUNTNUMS
- Case "DMax" : vFunction = com.sun.star.sheet.GeneralFunction.MAX
- Case "DMin" : vFunction = com.sun.star.sheet.GeneralFunction.MIN
- Case "DSum" : vFunction = com.sun.star.sheet.GeneralFunction.SUM
- Case Else : GoTo Finally
- End Select
- dblGet = oAddress.XCellRange.computeFunction(vFunction)
- Finally:
- _DFunction = dblGet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SF_Documents.SF_Calc._DFunction
- REM -----------------------------------------------------------------------------
- Function _GetColumnName(ByVal plColumnNumber As Long) As String
- ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ').
- ''' Args:
- ''' ColumnNumber: the column number, must be in the interval 1 ... 1024
- ''' Returns:
- ''' a string representation of the column name, in range 'A'..'AMJ'
- ''' Adapted from a Python function by sundar nataraj
- ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter
- Dim sCol As String ' Return value
- Dim lDiv As Long ' Intermediate result
- Dim lMod As Long ' Result of modulo 26 operation
- Try:
- lDiv = plColumnNumber
- Do While lDiv > 0
- lMod = (lDiv - 1) Mod 26
- sCol = Chr(65 + lMod) + sCol
- lDiv = Int((lDiv - lMod)/26)
- Loop
- Finally:
- _GetColumnName = sCol
- End Function ' SFDocuments.SF_Calc._GetColumnName
- REM -----------------------------------------------------------------------------
- Private Function _LastCell(ByRef poSheet As Object) As Variant
- ''' Returns in an array the coordinates of the last used cell in the given sheet
- Dim oCursor As Object ' Cursor on the cell
- Dim oRange As Object ' The used range
- Dim vCoordinates(0 To 1) As Long ' Return value: (0) = Column, (1) = Row
- Try:
- Set oCursor = poSheet.createCursorByRange(poSheet.getCellRangeByName("A1"))
- oCursor.gotoEndOfUsedArea(True)
- Set oRange = poSheet.getCellRangeByName(oCursor.AbsoluteName)
- vCoordinates(0) = oRange.RangeAddress.EndColumn + 1
- vCoordinates(1) = oRange.RangeAddress.EndRow + 1
- Finally:
- _LastCell = vCoordinates
- End Function ' SFDocuments.SF_Calc._LastCell
- REM -----------------------------------------------------------------------------
- Public Function _Offset(ByRef pvRange As Variant _
- , ByVal plRows As Long _
- , ByVal plColumns As Long _
- , ByVal plHeight As Long _
- , ByVal plWidth As Long _
- ) As Object
- ''' Returns a new range offset by a certain number of rows and columns from a given range
- ''' Args:
- ''' pvRange : the range, as a string or an object, from which the function searches for the new range
- ''' plRows : the number of rows by which the reference was corrected up (negative value) or down.
- ''' plColumns : the number of columns by which the reference was corrected to the left (negative value) or to the right.
- ''' plHeight : the vertical height for an area that starts at the new reference position.
- ''' plWidth : the horizontal width for an area that starts at the new reference position.
- ''' Arguments Rows and Columns must not lead to zero or negative start row or column.
- ''' Arguments Height and Width must not lead to zero or negative count of rows or columns.
- ''' Returns:
- ''' A new range as object of type _Address
- ''' Exceptions:
- ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
- Dim oOffset As Object ' Return value
- Dim oAddress As Object ' Alias of Range
- Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet
- Dim oRange As Object ' com.sun.star.table.XCellRange
- Dim oNewRange As Object ' com.sun.star.table.XCellRange
- Dim lLeft As Long ' New range coordinates
- Dim lTop As Long
- Dim lRight As Long
- Dim lBottom As Long
- Set oOffset = Nothing
- Check:
- If plHeight < 0 Or plWidth < 0 Then GoTo CatchAddress
- Try:
- If VarType(pvRange) = V_STRING Then Set oAddress = _ParseAddress(pvRange) Else Set oAddress = pvRange
- Set oSheet = oAddress.XSpreadSheet
- Set oRange = oAddress.XCellRange.RangeAddress
- ' Compute and validate new coordinates
- With oRange
- lLeft = .StartColumn + plColumns
- lTop = .StartRow + plRows
- lRight = lLeft + Iif(plWidth = 0, .EndColumn - .StartColumn, plWidth - 1)
- lBottom = lTop + Iif(plHeight = 0, .EndRow - .StartRow, plHeight - 1)
- If lLeft < 0 Or lRight < 0 Or lTop < 0 Or lBottom < 0 _
- Or lLeft > MAXCOLS Or lRight > MAXCOLS _
- Or lTop > MAXROWS Or lBottom > MAXROWS _
- Then GoTo CatchAddress
- Set oNewRange = oSheet.getCellRangeByPosition(lLeft, lTop, lRight, lBottom)
- End With
- ' Define the new range address
- Set oOffset = New _Address
- With oOffset
- .ObjectType = CALCREFERENCE
- .RawAddress = oNewRange.AbsoluteName
- .Component = _Component
- .XSpreadsheet = oNewRange.Spreadsheet
- .SheetName = .XSpreadsheet.Name
- .SheetIndex = .XSpreadsheet.RangeAddress.Sheet
- .RangeName = .RawAddress
- .XCellRange = oNewRange
- .Height = oNewRange.RangeAddress.EndRow - oNewRange.RangeAddress.StartRow + 1
- .Width = oNewRange.RangeAddress.EndColumn - oNewRange.RangeAddress.StartColumn + 1
- End With
- Finally:
- Set _Offset = oOffset
- Exit Function
- Catch:
- GoTo Finally
- CatchAddress:
- ScriptForge.SF_Exception.RaiseFatal(OFFSETADDRESSERROR, "Range", oAddress.RawAddress _
- , "Rows", plRows, "Columns", plColumns, "Height", plHeight, "Width", plWidth _
- , "Document", [_Super]._FileIdent())
- GoTo Finally
- End Function ' SF_Documents.SF_Calc._Offset
- REM -----------------------------------------------------------------------------
- Private Function _ParseAddress(ByVal psAddress As String) As Object
- ''' Parse and validate a sheet or range reference
- ''' Syntax to parse:
- ''' [Sheet].[Range]
- ''' Sheet => ['][$]sheet['] or document named range or ~
- ''' Range => A1:D10, A1, A:D, 10:10 ($ ignored), or sheet named range or ~
- ''' Returns:
- ''' An object of type _Address
- ''' Exceptions:
- ''' CALCADDRESSERROR ' Address could not be parsed to a valid address
- Dim oAddress As _Address ' Return value
- Dim lStart As Long ' Position of found regex
- Dim sSheet As String ' Sheet component
- Dim sRange As String ' Range component
- Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets
- Dim oNamedRanges As Object ' com.sun.star.sheet.XNamedRanges
- Dim oRangeAddress As Object ' Alias for rangeaddress
- Dim vLastCell As Variant ' Result of _LastCell() method
- Dim oSelect As Object ' Current selection
- With oAddress
- sSheet = "" : sRange = ""
- .SheetName = "" : .RangeName = ""
- .ObjectType = CALCREFERENCE
- .RawAddress = psAddress
- Set .XSpreadSheet = Nothing : Set .XCellRange = Nothing
-
- ' Split in sheet and range components - Check presence of surrounding single quotes or dot
- If Left(psAddress, 1) = "'" Then
- lStart = 1
- sSheet = ScriptForge.SF_String.FindRegex(psAddress, "^'[^\[\]*?:\/\\]+'")
- If lStart = 0 Then GoTo CatchAddress ' Invalid sheet name
- If Len(psAddress) > Len(sSheet) + 1 Then
- If Mid(psAddress, Len(sSheet) + 1, 1) = "." then sRange = Mid(psAddress, Len(sSheet) + 2)
- End If
- sSheet = Replace(Replace(sSheet, "$", ""), "'", "")
- ElseIf InStr(psAddress, ".") > 0 Then
- sSheet = Replace(Split(psAddress, ".")(0), "$", "")
- sRange = Replace(Split(psAddress, ".")(1), "$", "")
- Else
- sSheet = psAddress
- End If
- ' Resolve sheet part: either a document named range, or the active sheet or a real sheet
- Set oSheets = _Component.getSheets()
- Set oNamedRanges = _Component.NamedRanges
- If oSheets.hasByName(sSheet) Then
- ElseIf sSheet = "~" And Len(sRange) > 0 Then
- sSheet = _Component.CurrentController.ActiveSheet.Name
- ElseIf oNamedRanges.hasByName(sSheet) Then
- .XCellRange = oNamedRanges.getByName(sSheet).ReferredCells
- sSheet = oSheets.getByIndex(oNamedRanges.getByName(sSheet).ReferencePosition.Sheet).Name
- Else
- sRange = sSheet
- sSheet = _Component.CurrentController.ActiveSheet.Name
- End If
- .SheetName = sSheet
- .XSpreadSheet = oSheets.getByName(sSheet)
- .SheetIndex = .XSpreadSheet.RangeAddress.Sheet
- ' Resolve range part - either a sheet named range or the current selection or a real range or ""
- If IsNull(.XCellRange) Then
- Set oNamedRanges = .XSpreadSheet.NamedRanges
- If sRange = "~" Then
- Set oSelect = _Component.CurrentController.getSelection()
- If oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections
- Set .XCellRange = oSelect.getByIndex(0)
- Else
- Set .XCellRange = oSelect
- End If
- ElseIf sRange = "*" Or sRange = "" Then
- vLastCell = _LastCell(.XSpreadSheet)
- sRange = "A1:" & _GetColumnName(vLastCell(0)) & CStr(vLastCell(1))
- Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
- ElseIf oNamedRanges.hasByName(sRange) Then
- .XCellRange = oNamedRanges.getByName(sRange).ReferredCells
- Else
- On Local Error GoTo CatchError
- Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
- ' If range reaches the limits of the sheets, reduce it up to the used area
- Set oRangeAddress = .XCellRange.RangeAddress
- If oRangeAddress.StartColumn = 0 And oRangeAddress.EndColumn = MAXCOLS - 1 Then
- vLastCell = _LastCell(.XSpreadSheet)
- sRange = "A" & CStr(oRangeAddress.StartRow + 1) & ":" _
- & _GetColumnName(vLastCell(0)) & CStr(oRangeAddress.EndRow + 1)
- Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
- ElseIf oRangeAddress.StartRow = 0 And oRangeAddress.EndRow = MAXROWS - 1 Then
- vLastCell = _LastCell(.XSpreadSheet)
- sRange = _GetColumnName(oRangeAddress.StartColumn + 1) & "1" & ":" _
- & _GetColumnName(oRangeAddress.EndColumn + 1) & CStr(_LastCell(.XSpreadSheet)(1))
- Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
- End If
- End If
- End If
- If IsNull(.XCellRange) Then GoTo CatchAddress
- Set oRangeAddress = .XCellRange.RangeAddress
- .RangeName = _RangeToString(oRangeAddress)
- .Height = oRangeAddress.EndRow - oRangeAddress.StartRow + 1
- .Width = oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1
- ' Remember the current component in case of use outside the current instance
- Set .Component = _Component
- End With
- Finally:
- Set _ParseAddress = oAddress
- Exit Function
- CatchError:
- ScriptForge.SF_Exception.Clear()
- CatchAddress:
- ScriptForge.SF_Exception.RaiseFatal(CALCADDRESSERROR, "Range", psAddress _
- , "Document", [_Super]._FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Calc._ParseAddress
- REM -----------------------------------------------------------------------------
- Private Function _PropertyGet(Optional ByVal psProperty As String _
- , Optional ByVal pvArg As Variant _
- ) As Variant
- ''' Return the value of the named property
- ''' Args:
- ''' psProperty: the name of the property
- Dim oProperties As Object ' Document or Custom properties
- Dim vLastCell As Variant ' Coordinates of last used cell in a sheet
- Dim oSelect As Object ' Current selection
- Dim vRanges As Variant ' List of selected ranges
- Dim i As Long
- Dim cstThisSub As String
- Const cstSubArgs = ""
- _PropertyGet = False
- cstThisSub = "SFDocuments.SF_Calc.get" & psProperty
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not [_Super]._IsStillAlive() Then GoTo Finally
- Select Case psProperty
- Case "CurrentSelection"
- Set oSelect = _Component.CurrentController.getSelection()
- If IsNull(oSelect) Then
- _PropertyGet = Array()
- ElseIf oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections
- vRanges = Array()
- For i = 0 To oSelect.Count - 1
- vRanges = ScriptForge.SF_Array.Append(vRanges, oSelect.getByIndex(i).AbsoluteName)
- Next i
- _PropertyGet = vRanges
- Else
- _PropertyGet = oSelect.AbsoluteName
- End If
- Case "Height"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- _PropertyGet = 0
- Else
- If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
- _PropertyGet = _ParseAddress(pvArg).Height
- End If
- Case "LastCell", "LastColumn", "LastRow"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then ' Avoid errors when instance is watched in Basic IDE
- _PropertyGet = -1
- Else
- If Not _ValidateSheet(pvArg, "SheetName", , True) Then GoTo Finally
- vLastCell = _LastCell(_Component.getSheets.getByName(pvArg))
- If psProperty = "LastRow" Then
- _PropertyGet = vLastCell(1)
- ElseIf psProperty = "LastColumn" Then
- _PropertyGet = vLastCell(0)
- Else
- _PropertyGet = GetColumnName(vLastCell(0)) & CStr(vLastCell(1))
- End If
- End If
- Case "Range"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- Set _PropertyGet = Nothing
- Else
- If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
- Set _PropertyGet = _ParseAddress(pvArg)
- End If
- Case "Sheet"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- Set _PropertyGet = Nothing
- Else
- If Not _ValidateSheet(pvArg, "SheetName", , True) Then GoTo Finally
- Set _PropertyGet = _ParseAddress(pvArg)
- End If
- Case "Sheets"
- _PropertyGet = _Component.getSheets.getElementNames()
- Case "Width"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- _PropertyGet = 0
- Else
- If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
- _PropertyGet = _ParseAddress(pvArg).Width
- End If
- Case "XCellRange"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- Set _PropertyGet = Nothing
- Else
- If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
- Set _PropertyGet = _ParseAddress(pvArg).XCellRange
- End If
- Case "XSpreadsheet"
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- Set _PropertyGet = Nothing
- Else
- If Not _ValidateSheet(pvArg, "SheetName", , True) Then GoTo Finally
- Set _PropertyGet = _Component.getSheets.getByName(pvArg)
- End If
- Case Else
- _PropertyGet = Null
- End Select
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- End Function ' SFDocuments.SF_Calc._PropertyGet
- REM -----------------------------------------------------------------------------
- Private Function _RangeToString(ByRef poAddress As Object) As String
- ''' Converts a range address to its A1 notation)
- With poAddress
- _RangeToString = _GetColumnName(.StartColumn + 1) & CStr(.StartRow + 1) & ":" _
- & _GetColumnName(.EndColumn + 1) & CStr(.EndRow + 1)
- End With
- End Function ' SFDocuments.SF_Calc._RangeToString
- REM -----------------------------------------------------------------------------
- Private Function _Repr() As String
- ''' Convert the SF_Calc instance to a readable string, typically for debugging purposes (DebugPrint ...)
- ''' Args:
- ''' Return:
- ''' "[DOCUMENT]: Type/File"
- _Repr = "[Calc]: " & [_Super]._FileIdent()
- End Function ' SFDocuments.SF_Calc._Repr
- REM -----------------------------------------------------------------------------
- Private Sub _RestoreSelections(ByRef pvComponent As Variant _
- , ByRef pvSelection As Variant _
- )
- ''' Set the selection to a single or a multiple range
- ''' Does not work well when multiple selections and macro terminating in Basic IDE
- ''' Called by the CopyToCell and CopyToRange methods
- ''' Args:
- ''' pvComponent: should work for foreign instances as well
- ''' pvSelection: the stored selection done previously by Component.CurrentController.getSelection()
- Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
- Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
- Dim i As Long
- Try:
- If IsArray(pvSelection) Then
- Set oCellRanges = pvComponent.createInstance("com.sun.star.sheet.SheetCellRanges")
- vRangeAddresses = Array()
- ReDim vRangeAddresses(0 To UBound(pvSelection))
- For i = 0 To UBound(pvSelection)
- vRangeAddresses(i) = pvSelection.getByIndex(i).RangeAddress
- Next i
- oCellRanges.addRangeAddresses(vRangeAddresses, False)
- pvComponent.CurrentController.select(oCellRanges)
- Else
- pvComponent.CurrentController.select(pvSelection)
- End If
- Finally:
- Exit Sub
- End Sub ' SFDocuments.SF_Calc._RestoreSelections
- REM -----------------------------------------------------------------------------
- Private Function _ValidateSheet(Optional ByRef pvSheetName As Variant _
- , Optional ByVal psArgName As String _
- , Optional ByVal pvNew As Variant _
- , Optional ByVal pvActive As Variant _
- , Optional ByVal pvOptional as Variant _
- , Optional ByVal pvNumeric As Variant _
- , Optional ByVal pvReference As Variant _
- ) As Boolean
- ''' Sheet designation validation function similar to the SF_Utils._ValidateXXX functions
- ''' Args:
- ''' pvSheetName: string or numeric position
- ''' pvNew: if True, sheet must not exist (default = False)
- ''' pvActive: if True, the shortcut "~" is accepted (default = False)
- ''' pvOptional: if True, a zero-length string is accepted (default = False)
- ''' pvNumeric: if True, the sheet position is accepted (default = False)
- ''' pvReference: if True, a sheet reference is acceptable (default = False)
- ''' pvNumeric and pvReference must not both be = True
- ''' Returns
- ''' True if valid. SheetName is reset to current value if = "~"
- ''' Exceptions
- ''' DUPLICATESHEETERROR A sheet with the given name exists already
- Dim vSheets As Variant ' List of sheets
- Dim vTypes As Variant ' Array of accepted variable types
- Dim bValid As Boolean ' Return value
- Check:
- If IsMissing(pvNew) Or IsEmpty(pvNew) Then pvNew = False
- If IsMissing(pvActive) Or IsEmpty(pvActive) Then pvActive = False
- If IsMissing(pvOptional) Or IsEmpty(pvOptional) Then pvOptional = False
- If IsMissing(pvNumeric) Or IsEmpty(pvNumeric) Then pvNumeric = False
- If IsMissing(pvReference) Or IsEmpty(pvReference) Then pvReference = False
- ' Define the acceptable variable types
- If pvNumeric Then
- vTypes = Array(V_STRING, V_NUMERIC)
- ElseIf pvReference Then
- vTypes = Array(V_STRING, ScriptForge.V_OBJECT)
- Else
- vTypes = V_STRING
- End If
- If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, vTypes, , , Iif(pvReference, CALCREFERENCE, "")) Then GoTo Finally
- bValid = False
- Try:
- If VarType(pvSheetName) = V_STRING Then
- If pvOptional And Len(pvSheetName) = 0 Then
- ElseIf pvActive And pvSheetName = "~" Then
- pvSheetName = _Component.CurrentController.ActiveSheet.Name
- Else
- vSheets = _Component.getSheets.getElementNames()
- If pvNew Then
- If ScriptForge.SF_Array.Contains(vSheets, pvSheetName) Then GoTo CatchDuplicate
- Else
- If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, V_STRING, vSheets) Then GoTo Finally
- End If
- End If
- End If
- bValid = True
-
- Finally:
- _ValidateSheet = bValid
- Exit Function
- CatchDuplicate:
- ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, psArgName, pvSheetName, "Document", [_Super]._FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Calc._ValidateSheet
- REM ============================================ END OF SFDOCUMENTS.SF_CALC
- </script:module>
|