| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844 |
- <?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>
|