1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669 |
- <?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
- ''' managing and manipulating 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_Base, ...
- '''
- ''' 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
- '''
- ''' Several methods may receive a "FilterFormula" as argument.
- ''' A FilterFormula may be associated with a FilterScope: "row", "column" or "cell".
- ''' These arguments determines on which rows/columns/cells of a range the method should be applied
- ''' Examples:
- ''' oDoc.ClearAll("A1:J10", FilterFormula := "=(A1<=0)", FilterScope := "CELL") ' Clear all negative values
- ''' oDoc.ClearAll("A2:J10", FilterFormula := "=(A2<>A1)", FilterScope := "COLUMN") ' Clear when identical to above cell
- '''
- ''' FilterFormula: a Calc formula that returns TRUE or FALSE
- ''' the formula is expressed in terms of
- ''' - the top-left cell of the range when FilterScope = "CELL"
- ''' - the topmost row of the range when FilterScope = "ROW"
- ''' - the leftmost column of the range when FilterScope = "COLUMN"
- ''' relative and absolute references will be interpreted correctly
- ''' FilterScope: the way the formula is applied, once by row, by column, or by individual cell
- '''
- ''' Detailed user documentation:
- ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC
- '''
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- REM ================================================================== EXCEPTIONS
- Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR"
- Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR"
- Private Const CALCADDRESSERROR = "CALCADDRESSERROR"
- Private Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR"
- Private Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR"
- Private Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR"
- Private Const DUPLICATECHARTERROR = "DUPLICATECHARTERROR"
- Private Const RANGEEXPORTERROR = "RANGEEXPORTERROR"
- REM ============================================================= PRIVATE MEMBERS
- Private [Me] 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"
- ServiceName As String ' Must be "SFDocuments.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
- Private _LastParsedAddress As Object ' _Address type - parsed ranges are cached
- REM ============================================================ MODULE CONSTANTS
- Private Const cstSHEET = 1
- Private Const cstRANGE = 2
- Private Const MAXCOLS = 2^14 ' 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
- Private Const SERVICEREFERENCE = "SFDocuments.CalcReference"
- ' Service name of _Address (used in Python)
- Private Const ISCALCFORM = 2 ' Form is stored in a Calc document
- Private Const cstSPECIALCHARS = " `~!@#$%^&()-_=+{}|;,<.>"""
- ' Presence of a special character forces surrounding the sheet name with single quotes in absolute addresses
- REM ====================================================== CONSTRUCTOR/DESTRUCTOR
- REM -----------------------------------------------------------------------------
- Private Sub Class_Initialize()
- Set [Me] = Nothing
- Set [_Super] = Nothing
- ObjectType = "CALC"
- ServiceName = "SFDocuments.Calc"
- Set _Component = Nothing
- Set _LastParsedAddress = 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 _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 FirstCell(Optional ByVal RangeName As Variant) As String
- ''' Returns the First used cell in a given range or sheet
- ''' When the argument is a sheet it will always return the "sheet.$A$1" cell
- FirstCell = _PropertyGet("FirstCell", RangeName)
- End Property ' SFDocuments.SF_Calc.FirstCell
- REM -----------------------------------------------------------------------------
- Property Get FirstColumn(Optional ByVal RangeName As Variant) As Long
- ''' Returns the leftmost column in a given sheet or range
- ''' When the argument is a sheet it will always return 1
- FirstColumn = _PropertyGet("FirstColumn", RangeName)
- End Property ' SFDocuments.SF_Calc.FirstColumn
- REM -----------------------------------------------------------------------------
- Property Get FirstRow(Optional ByVal RangeName As Variant) As Long
- ''' Returns the First used column in a given range
- ''' When the argument is a sheet it will always return 1
- FirstRow = _PropertyGet("FirstRow", RangeName)
- End Property ' SFDocuments.SF_Calc.FirstRow
- 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 RangeName As Variant) As String
- ''' Returns the last used cell in a given sheet or range
- LastCell = _PropertyGet("LastCell", RangeName)
- End Property ' SFDocuments.SF_Calc.LastCell
- REM -----------------------------------------------------------------------------
- Property Get LastColumn(Optional ByVal RangeName As Variant) As Long
- ''' Returns the last used column in a given sheet
- LastColumn = _PropertyGet("LastColumn", RangeName)
- End Property ' SFDocuments.SF_Calc.LastColumn
- REM -----------------------------------------------------------------------------
- Property Get LastRow(Optional ByVal RangeName As Variant) As Long
- ''' Returns the last used column in a given sheet
- LastRow = _PropertyGet("LastRow", RangeName)
- 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 Region(Optional ByVal RangeName As Variant) As String
- ''' Returns the smallest area as a range string that contains the given range
- ''' and which is completely surrounded with empty cells
- Region = _PropertyGet("Region", RangeName)
- End Property ' SFDocuments.SF_Calc.Region
- 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 SheetName(Optional ByVal RangeName As Variant) As String
- ''' Returns the sheet name part of a range
- SheetName = _PropertyGet("SheetName", RangeName)
- End Property ' SFDocuments.SF_Calc.SheetName
- 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 XSheetCellCursor(Optional ByVal RangeName As Variant) As Variant
- ''' Returns a UNO object of type com.sun.star.sheet.XSheetCellCursor
- '' After having moved the cursor (gotoNext(), ...) the resulting range can be got
- ''' back as a string with the cursor.AbsoluteName UNO property.
- XSheetCellCursor = _PropertyGet("XSheetCellCursor", RangeName)
- End Property ' SFDocuments.SF_Calc.XSheetCellCursor
- 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 A1Style(Optional ByVal Row1 As Variant _
- , Optional ByVal Column1 As Variant _
- , Optional ByVal Row2 As Variant _
- , Optional ByVal Column2 As Variant _
- , Optional ByVal SheetName As Variant _
- ) As String
- ''' Returns a range expressed in A1-style as defined by its coordinates
- ''' If only one pair of coordinates is given, the range will embrace only a single cell
- ''' Args:
- ''' Row1 : the row number of the first coordinate
- ''' Column1 : the column number of the first coordinates
- ''' Row2 : the row number of the second coordinate
- ''' Column2 : the column number of the second coordinates
- ''' SheetName: Default = the current sheet. If present, the sheet must exist.
- ''' Returns:
- ''' A range as a string
- ''' Exceptions:
- ''' Examples:
- ''' range = oDoc.A1Style(5, 2, 10, 4, "SheetX") ' "'$SheetX'.$E$2:$J$4"
- Dim sA1Style As String ' Return value
- Dim vSheetName As Variant ' Alias of SheetName - necessary see [Bug 145279]
- Dim lTemp As Long ' To switch 2 values
- Dim i As Long
- Const cstThisSub = "SFDocuments.Calc.A1Style"
- Const cstSubArgs = "Row1, Column1, [Row2], [Column2], [SheetName]="""""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sA1Style = ""
- Check:
- If IsMissing(Row2) Or IsEmpty(Row2) Then Row2 = 0
- If IsMissing(Column2) Or IsEmpty(Column2) Then Column2 = 0
- If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = "~"
- vSheetName = SheetName
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Row1, "Row1", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Column1, "Column1", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Row2, "Row2", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Column2, "Column2", ScriptForge.V_NUMERIC) Then GoTo Finally
- If Not _ValidateSheet(vSheetName, "SheetName", , True, True, , , True) Then GoTo Finally
- End If
- If Row1 > MAXROWS Then Row1 = MAXROWS
- If Row2 > MAXROWS Then Row2 = MAXROWS
- If Column1 > MAXCOLS Then Column1 = MAXCOLS
- If Column2 > MAXCOLS Then Column2 = MAXCOLS
- If Row2 > 0 And Row2 < Row1 Then
- lTemp = Row2 : Row2 = Row1 : Row1 = lTemp
- End If
- If Column2 > 0 And Column2 < Column1 Then
- lTemp = Column2 : Column2 = Column1 : Column1 = lTemp
- End If
- Try:
- ' Surround the sheet name with single quotes when required by the presence of special characters
- vSheetName = _QuoteSheetName(vSheetName)
- ' Define the new range string
- sA1Style = "$" & vSheetName & "." _
- & "$" & _GetColumnName(Column1) & "$" & CLng(Row1) _
- & Iif(Row2 > 0 And Column2 > 0, ":$" & _GetColumnName(Column2) & "$" & CLng(Row2), "")
- Finally:
- A1Style = sA1Style
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.A1Style
- 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 _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 Function Charts(Optional ByVal SheetName As Variant _
- , Optional ByVal ChartName As Variant _
- ) As Variant
- ''' Return either the list of charts present in the given sheet or a chart object
- ''' Args:
- ''' SheetName: The name of an existing sheet
- ''' ChartName: The user-defined name of the targeted chart or the zero-length string
- ''' Returns:
- ''' When ChartName = "", return the list of the charts present in the sheet,
- ''' otherwise, return a new chart service instance
- ''' Examples:
- ''' Dim oChart As Object
- ''' Set oChart = oDoc.Charts("SheetX", "myChart")
- Dim vCharts As Variant ' Return value when array of chart names
- Dim oChart As Object ' Return value when new chart instance
- Dim oSheet As Object ' Alias of SheetName as reference
- Dim oDrawPage As Object ' com.sun.star.drawing.XDrawPage
- Dim oNextShape As Object ' com.sun.star.drawing.XShape
- Dim sChartName As String ' Some chart name
- Dim lCount As Long ' Counter for charts among all drawing objects
- Dim i As Long
- Const cstChartShape = "com.sun.star.drawing.OLE2Shape"
- Const cstThisSub = "SFDocuments.Calc.Charts"
- Const cstSubArgs = "SheetName, [ChartName=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- vCharts = Array()
- Check:
- If IsMissing(ChartName) Or IsEmpty(ChartName) Then ChartName = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Because the user can change it constantly, the list of valid charts has to be rebuilt at each time
- ' Explore charts starting from the draw page
- Set oSheet = _Component.getSheets.getByName(SheetName)
- Set oDrawPage = oSheet.getDrawPage()
- vCharts = Array()
- Set oChart = Nothing
- lCount = -1
- For i = 0 To oDrawPage.Count - 1
- Set oNextShape = oDrawPage.getByIndex(i)
- if oNextShape.supportsService(cstChartShape) Then ' Ignore other shapes
- sChartName = oNextShape.Name ' User-defined name
- If Len(sChartName) = 0 Then sChartName = oNextShape.PersistName ' Internal name
- ' Is chart found ?
- If Len(ChartName) > 0 Then
- If ChartName = sChartName Then
- Set oChart = New SF_Chart
- With oChart
- Set .[Me] = oChart
- Set .[_Parent] = [Me]
- ._SheetName = SheetName
- ._DrawIndex = i
- ._ChartName = ChartName
- ._PersistentName = oNextShape.PersistName
- Set ._Shape = oNextShape
- Set ._Chart = oSheet.getCharts().getByName(._PersistentName)
- Set ._ChartObject = ._Chart.EmbeddedObject
- Set ._Diagram = ._ChartObject.Diagram
- End With
- Exit For
- End If
- End If
- ' Build stack of chart names
- lCount = lCount + 1
- If UBound(vCharts) < 0 Then
- vCharts = Array(sChartName)
- Else
- ReDim Preserve vCharts(0 To UBound(vCharts) + 1)
- vCharts(lCount) = sChartName
- End If
- End If
- Next i
- ' Raise error when chart not found
- If Len(ChartName) > 0 And IsNull(oChart) Then
- If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING, vCharts) Then GoTo Finally
- End If
- Finally:
- If Len(ChartName) = 0 Then Charts = vCharts Else Set Charts = oChart
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.Charts
- REM -----------------------------------------------------------------------------
- Public Sub ClearAll(Optional ByVal Range As Variant _
- , Optional FilterFormula As Variant _
- , Optional FilterScope As Variant _
- )
- ''' Clear entirely the given range
- ''' Args:
- ''' Range : the cell or the range as a string that should be cleared
- ''' FilterFormula: a Calc formula to select among the given Range
- ''' When left empty, all the cells of the range are cleared
- ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
- ''' When FilterFormula is present, FilterScope is mandatory
- ''' Examples:
- ''' oDoc.ClearAll("SheetX") ' Clears the used area of the sheet
- ''' oDoc.ClearAll("A1:J20", "=($A1=0)", "ROW") ' Clears all rows when 1st cell is zero
- _ClearRange("All", Range, FilterFormula, FilterScope)
- End Sub ' SFDocuments.SF_Calc.ClearAll
- REM -----------------------------------------------------------------------------
- Public Sub ClearFormats(Optional ByVal Range As Variant _
- , Optional FilterFormula As Variant _
- , Optional FilterScope As Variant _
- )
- ''' Clear all the formatting elements of the given range
- ''' Args:
- ''' Range : the cell or the range as a string that should be cleared
- ''' FilterFormula: a Calc formula to select among the given Range
- ''' When left empty, all the cells of the range are cleared
- ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
- ''' When FilterFormula is present, FilterScope is mandatory
- ''' Examples:
- ''' oDoc.ClearFormats("SheetX.*") ' Clears the used area of the sheet
- ''' oDoc.ClearFormats("A1:J20", "=(MOD(A1;0)=0)", "CELL") ' Clears all even cells
- _ClearRange("Formats", Range, FilterFormula, FilterScope)
- End Sub ' SFDocuments.SF_Calc.ClearFormats
- REM -----------------------------------------------------------------------------
- Public Sub ClearValues(Optional ByVal Range As Variant _
- , Optional FilterFormula As Variant _
- , Optional FilterScope As Variant _
- )
- ''' Clear values and formulas in the given range
- ''' Args:
- ''' Range : the cell or the range as a string that should be cleared
- ''' FilterFormula: a Calc formula to select among the given Range
- ''' When left empty, all the cells of the range are cleared
- ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
- ''' When FilterFormula is present, FilterScope is mandatory
- ''' Examples:
- ''' oDoc.ClearValues("SheetX.*") ' Clears the used area of the sheet
- ''' oDoc.ClearValues("A2:A20", "=(A2=A1)", "CELL") ' Clears all duplicate cells
- _ClearRange("Values", Range, FilterFormula, FilterScope)
- End Sub ' SFDocuments.SF_Calc.ClearValues
- REM -----------------------------------------------------------------------------
- Public Function CompactLeft(Optional ByVal Range As Variant _
- , Optional ByVal WholeColumn As Variant _
- , Optional ByVal FilterFormula As Variant _
- ) As String
- ''' Delete the columns of a specified range matching a filter expressed as a formula
- ''' applied on each column.
- ''' The deleted cells can span whole columns or be limited to the height of the range
- ''' The execution of the method has no effect on the current selection
- ''' Args:
- ''' Range: the range in which cells have to be erased, as a string
- ''' WholeColumn: when True (default = False), erase whole columns
- ''' FilterFormula: the formula to be applied on each column.
- ''' The column is erased when the formula results in True,
- ''' The formula shall probably involve one or more cells of the first column of the range.
- ''' By default, a column is erased when all the cells of the column are empty,
- ''' i.e. suppose the range is "A1:J200" (height = 200) the default value becomes
- ''' "=(COUNTBLANK(A1:A200)=200)"
- ''' Returns:
- ''' A string representing the location of the initial range after compaction,
- ''' or the zero-length string if the whole range has been deleted
- ''' Examples:
- ''' newrange = oDoc.CompactLeft("SheetX.G1:L10") ' All empty columns of the range are suppressed
- ''' newrange = oDoc.CompactLeft("SheetX.G1:L10", WholeColumn := True, FilterFormula := "=(G$7=""X"")")
- ''' ' The columns having a "X" in row 7 are completely suppressed
- Dim sCompact As String ' Return value
- Dim oCompact As Object ' Return value as an _Address type
- Dim lCountDeleted As Long ' Count the deleted columns
- Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
- Dim oSourceAddress As Object ' Alias of Range as _Address
- Dim oPartialRange As Object ' Contiguous columns to be deleted
- Dim sShiftRange As String ' Contiguous columns to be shifted
- Dim i As Long
- Const cstThisSub = "SFDocuments.Calc.CompactLeft"
- Const cstSubArgs = "Range, [WholeColumn=False], [FilterFormula=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sCompact = ""
- Check:
- If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
- If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Range)
- lCountDeleted = 0
- With oSourceAddress
- ' Set the default formula => all cells are blank
- If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height & "=0)", Range)
- ' Identify the ranges to compact based on the given formula
- vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula, "COLUMN")
- ' Iterate through the ranges from bottom to top and shift them up
- For i = UBound(vCompactRanges) To 0 Step -1
- Set oPartialRange = vCompactRanges(i)
- ShiftLeft(oPartialRange.RangeName, WholeColumn)
- lCountDeleted = lCountDeleted + oPartialRange.Width
- Next i
-
- ' Compute the final range position
- If lCountDeleted < .Width Then sCompact = Offset(Range, 0, 0, 0, .Width - lCountDeleted)
- ' Push to the right the cells that migrated leftwards irrelevantly
- If Not WholeColumn Then
- If Len(sCompact) > 0 Then
- sShiftRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted)
- Else
- sShiftRange = .RangeName
- End If
- ShiftRight(sShiftRange, WholeColumn := False)
- End If
- End With
- Finally:
- CompactLeft = sCompact
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' When error, return the original range
- If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CompactLeft
- REM -----------------------------------------------------------------------------
- Public Function CompactUp(Optional ByVal Range As Variant _
- , Optional ByVal WholeRow As Variant _
- , Optional ByVal FilterFormula As Variant _
- ) As String
- ''' Delete the rows of a specified range matching a filter expressed as a formula
- ''' applied on each row.
- ''' The deleted cells can span whole rows or be limited to the width of the range
- ''' The execution of the method has no effect on the current selection
- ''' Args:
- ''' Range: the range in which cells have to be erased, as a string
- ''' WholeRow: when True (default = False), erase whole rows
- ''' FilterFormula: the formula to be applied on each row.
- ''' The row is erased when the formula results in True,
- ''' The formula shall probably involve one or more cells of the first row of the range.
- ''' By default, a row is erased when all the cells of the row are empty,
- ''' i.e. suppose the range is "A1:J200" (width = 10) the default value becomes
- ''' "=(COUNTBLANK(A1:J1)=10)"
- ''' Returns:
- ''' A string representing the location of the initial range after compaction,
- ''' or the zero-length string if the whole range has been deleted
- ''' Examples:
- ''' newrange = oDoc.CompactUp("SheetX.G1:L10") ' All empty rows of the range are suppressed
- ''' newrange = oDoc.CompactUp("SheetX.G1:L10", WholeRow := True, FilterFormula := "=(G1=""X"")")
- ''' ' The rows having a "X" in column G are completely suppressed
- Dim sCompact As String ' Return value
- Dim oCompact As Object ' Return value as an _Address type
- Dim lCountDeleted As Long ' Count the deleted rows
- Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
- Dim oSourceAddress As Object ' Alias of Range as _Address
- Dim oPartialRange As Object ' Contiguous rows to be deleted
- Dim sShiftRange As String ' Contiguous rows to be shifted
- Dim i As Long
- Const cstThisSub = "SFDocuments.Calc.CompactUp"
- Const cstSubArgs = "Range, [WholeRow=False], [FilterFormula=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sCompact = ""
- Check:
- If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
- If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Range)
- lCountDeleted = 0
- With oSourceAddress
- ' Set the default formula => all cells are blank
- If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width & "=0)", Range)
- ' Identify the ranges to compact based on the given formula
- vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula, "ROW")
- ' Iterate through the ranges from bottom to top and shift them up
- For i = UBound(vCompactRanges) To 0 Step -1
- Set oPartialRange = vCompactRanges(i)
- ShiftUp(oPartialRange.RangeName, WholeRow)
- lCountDeleted = lCountDeleted + oPartialRange.Height
- Next i
-
- ' Compute the final range position
- If lCountDeleted < .Height Then sCompact = Offset(Range, 0, 0, .Height - lCountDeleted, 0)
- ' Push downwards the cells that migrated upwards irrelevantly
- If Not WholeRow Then
- If Len(sCompact) > 0 Then
- sShiftRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted)
- Else
- sShiftRange = .RangeName
- End If
- ShiftDown(sShiftRange, WholeRow := False)
- End If
- End With
- Finally:
- CompactUp = sCompact
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' When error, return the original range
- If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CompactUp
- 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 _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.NV", 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
- ''' 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 _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 via 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 a range of cells, 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 _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 _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 CreateChart(Optional ByVal ChartName As Variant _
- , Optional ByVal SheetName As Variant _
- , Optional ByVal Range As Variant _
- , Optional ColumnHeader As Variant _
- , Optional RowHeader As Variant _
- ) As Variant
- ''' Return a new chart instance initialized with default values
- ''' Args:
- ''' ChartName: The user-defined name of the new chart
- ''' SheetName: The name of an existing sheet
- ''' Range: the cell or the range as a string that should be drawn
- ''' ColumnHeader: when True, the topmost row of the range will be used to set labels for the category axis or the legend.
- ''' Default = False
- ''' RowHeader: when True, the leftmost column of the range will be used to set labels for the category axis or the legend.
- ''' Default = False
- ''' Returns:
- ''' A new chart service instance
- ''' Exceptions:
- ''' DUPLICATECHARTERROR A chart with the same name exists already in the given sheet
- ''' Examples:
- ''' Dim oChart As Object
- ''' Set oChart = oDoc.CreateChart("myChart", "SheetX", "A1:C8", ColumnHeader := True)
- Dim oChart As Object ' Return value
- Dim vCharts As Variant ' List of pre-existing charts
- Dim oSheet As Object ' Alias of SheetName as reference
- Dim oRange As Object ' Alias of Range
- Dim oRectangle as new com.sun.star.awt.Rectangle ' Simple shape
- Const cstThisSub = "SFDocuments.Calc.CreateChart"
- Const cstSubArgs = "ChartName, SheetName, Range, [ColumnHeader=False], [RowHeader=False]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Set oChart = Nothing
- Check:
- If IsMissing(RowHeader) Or IsEmpty(RowHeader) Then Rowheader = False
- If IsMissing(ColumnHeader) Or IsEmpty(ColumnHeader) Then ColumnHeader = False
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ColumnHeader, "ColumnHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(RowHeader, "RowHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
- End If
- vCharts = Charts(SheetName)
- If ScriptForge.SF_Array.Contains(vCharts, ChartName, CaseSensitive := True) Then GoTo CatchDuplicate
- Try:
- ' The rectangular shape receives arbitrary values. User can Resize() it later
- With oRectangle
- .X = 0 : .Y = 0
- .Width = 8000 : .Height = 6000
- End With
- ' Initialize sheet and range
- Set oSheet = _Component.getSheets.getByName(SheetName)
- Set oRange = _ParseAddress(Range)
- ' Create the chart and get ihe corresponding chart instance
- oSheet.getCharts.addNewByName(ChartName, oRectangle, Array(oRange.XCellRange.RangeAddress), ColumnHeader, RowHeader)
- Set oChart = Charts(SheetName, ChartName)
- oChart._Shape.Name = ChartName ' Both user-defined and internal names match ChartName
- oChart._Diagram.Wall.FillColor = RGB(255, 255, 255) ' Align on background color set by the user interface by default
- Finally:
- Set CreateChart = oChart
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchDuplicate:
- ScriptForge.SF_Exception.RaiseFatal(DUPLICATECHARTERROR, "ChartName", ChartName, "SheetName", SheetName, "Document", [_Super]._FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CreateChart
- REM -----------------------------------------------------------------------------
- Public Function CreatePivotTable(Optional ByVal PivotTableName As Variant _
- , Optional ByVal SourceRange As Variant _
- , Optional ByVal TargetCell As Variant _
- , Optional ByRef DataFields As Variant _
- , Optional ByRef RowFields As Variant _
- , Optional ByRef ColumnFields As Variant _
- , Optional ByVal FilterButton As Variant _
- , Optional ByVal RowTotals As Variant _
- , Optional ByVal ColumnTotals As Variant _
- ) As String
- ''' Create a new pivot table with the properties defined by the arguments.
- ''' If a pivot table with the same name exists already in the targeted sheet, it will be erased without warning.
- ''' Args:
- ''' PivotTableName: The user-defined name of the new pivottable
- ''' SourceRange: The range as a string containing the raw data.
- ''' The first row of the range is presumed to contain the field names of the new pivot table
- ''' TargetCell: the top left cell or the range as a string where to locate the pivot table.
- ''' Only the top left cell of the range will be considered.
- ''' DataFields: A single string or an array of field name + function to apply, formatted like:
- ''' Array("FieldName[;Function]", ...)
- ''' The allowed functions are: Sum, Count, Average, Max, Min, Product, CountNums, StDev, StDevP, Var, VarP and Median.
- ''' The default function is: When the values are all numerical, Sum is used, otherwise Count
- ''' RowFields: A single string or an array of the field names heading the pivot table rows
- ''' ColumnFields: A single string or an array of the field names heading the pivot table columns
- ''' FilterButton: When True (default), display a "Filter" button above the pivot table
- ''' RowTotals: When True (default), display a separate column for row totals
- ''' ColumnTotals: When True (default), display a separate row for column totals
- ''' Returns:
- ''' Return the range where the new pivot table is deployed.
- ''' Examples:
- ''' Dim vData As Variant, oDoc As Object, sTable As String, sPivot As String
- ''' vData = Array(Array("Item", "State", "Team", "2002", "2003", "2004"), _
- ''' Array("Books", "Michigan", "Jean", 14788, 30222, 23490), _
- ''' Array("Candy", "Michigan", "Jean", 26388, 15641, 32849), _
- ''' Array("Pens", "Michigan", "Jean", 16569, 32675, 25396), _
- ''' Array("Books", "Michigan", "Volker", 21961, 21242, 29009), _
- ''' Array("Candy", "Michigan", "Volker", 26142, 22407, 32841))
- ''' Set oDoc = ui.CreateDocument("Calc")
- ''' sTable = oDoc.SetArray("A1", vData)
- ''' sPivot = oDoc.CreatePivotTable("PT1", sTable, "H1", Array("2002", "2003;count", "2004;average"), "Item", Array("State", "Team"), False)
- Dim sPivotTable As String ' Return value
- Dim vData As Variant ' Alias of DataFields
- Dim vRows As Variant ' Alias of RowFields
- Dim vColumns As Variant ' Alias of ColumnFields
- Dim oSourceAddress As Object ' Source as an _Address
- Dim oTargetAddress As Object ' Target as an _Address
- Dim vHeaders As Variant ' Array of header fields in the source range
- Dim oPivotTables As Object ' com.sun.star.sheet.XDataPilotTables
- Dim oDescriptor As Object ' com.sun.star.sheet.DataPilotDescriptor
- Dim oFields As Object ' ScDataPilotFieldsObj - Collection of fields
- Dim oField As Object ' ScDataPilotFieldsObj - A single field
- Dim sField As String ' A single field name
- Dim sData As String ' A single data field name + function
- Dim vDataField As Variant ' A single vData element, split on semicolon
- Dim sFunction As String ' Function to apply on a data field (string)
- Dim iFunction As Integer ' Equivalent of sFunction as com.sun.star.sheet.GeneralFunction2 constant
- Dim oOutputRange As Object ' com.sun.star.table.CellRangeAddress
- Dim i As Integer
- Const cstThisSub = "SFDocuments.Calc.CreatePivotTable"
- Const cstSubArgs = "PivotTableName, SourceRange, TargetCell, DataFields, [RowFields], [ColumnFields]" _
- & ", [FilterButton=True], [RowTotals=True], [ColumnTotals=True]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sPivotTable = ""
- Check:
- If IsMissing(RowFields) Or IsEmpty(RowFields) Then RowFields = Array()
- If IsMissing(ColumnFields) Or IsEmpty(ColumnFields) Then ColumnFields = Array()
- If IsMissing(FilterButton) Or IsEmpty(FilterButton) Then FilterButton = True
- If IsMissing(RowTotals) Or IsEmpty(RowTotals) Then RowTotals = True
- If IsMissing(ColumnTotals) Or IsEmpty(ColumnTotals) Then ColumnTotals = True
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(PivotTableName, "PivotTableName", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
- If IsArray(DataFields) Then
- If Not ScriptForge.SF_Utils._ValidateArray(DataFields, "DataFields", 1, V_STRING, True) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(DataFields, "DataFields", V_STRING) Then GoTo Finally
- End If
- If IsArray(RowFields) Then
- If Not ScriptForge.SF_Utils._ValidateArray(RowFields, "RowFields", 1, V_STRING, True) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(RowFields, "RowFields", V_STRING) Then GoTo Finally
- End If
- If IsArray(ColumnFields) Then
- If Not ScriptForge.SF_Utils._ValidateArray(ColumnFields, "ColumnFields", 1, V_STRING, True) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(ColumnFields, "ColumnFields", V_STRING) Then GoTo Finally
- End If
- If Not ScriptForge.SF_Utils._Validate(FilterButton, "FilterButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(RowTotals, "RowTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ColumnTotals, "ColumnTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
- End If
- ' Next statements must be outside previous If-block to force their execution even in case of internal call
- If IsArray(DataFields) Then vData = DataFields Else vData = Array(DataFields)
- If IsArray(RowFields) Then vRows = RowFields Else vRows = Array(RowFields)
- If IsArray(ColumnFields) Then vColumns = ColumnFields Else vColumns = Array(ColumnFields)
- Try:
- Set oSourceAddress = _ParseAddress(SourceRange)
- vHeaders = GetValue(Offset(SourceRange, 0, 0, 1)) ' Content of the first row of the source
- Set oTargetAddress = _Offset(TargetCell, 0, 0, 1, 1) ' Retain the top left cell only
- Set oPivotTables = oTargetAddress.XSpreadsheet.getDataPilotTables()
- ' Initialize new pivot table
- Set oDescriptor = oPivotTables.createDataPilotDescriptor()
- oDescriptor.setSourceRange(oSourceAddress.XCellRange.RangeAddress)
- Set oFields = oDescriptor.getDataPilotFields()
- ' Set row fields
- For i = 0 To UBound(vRows)
- sField = vRows(i)
- If Len(sField) > 0 Then
- If Not ScriptForge.SF_Utils._Validate(sField, "RowFields", V_STRING, vHeaders) Then GoTo Finally
- Set oField = oFields.getByName(sField)
- oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
- End If
- Next i
- ' Set column fields
- For i = 0 To UBound(vColumns)
- sField = vColumns(i)
- If Len(sField) > 0 Then
- If Not ScriptForge.SF_Utils._Validate(sField, "ColumnFields", V_STRING, vHeaders) Then GoTo Finally
- Set oField = oFields.getByName(sField)
- oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN
- End If
- Next i
- ' Set data fields
- For i = 0 To UBound(vData)
- sData = vData(i)
- ' Minimal parsing
- If Right(sData, 1) = ";" Then sData = Left(sData, Len(sData) - 1)
- vDataField = Split(sData, ";")
- sField = vDataField(0)
- If UBound(vDataField) > 0 Then sFunction = vDataField(1) Else sFunction = ""
- ' Define field properties
- If Len(sField) > 0 Then
- If Not ScriptForge.SF_Utils._Validate(sField, "DataFields", V_STRING, vHeaders) Then GoTo Finally
- Set oField = oFields.getByName(sField)
- oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
- ' Associate the correct function
- With com.sun.star.sheet.GeneralFunction2
- Select Case UCase(sFunction)
- Case "" : iFunction = .AUTO
- Case "SUM" : iFunction = .SUM
- Case "COUNT" : iFunction = .COUNT
- Case "AVERAGE" : iFunction = .AVERAGE
- Case "MAX" : iFunction = .MAX
- Case "MIN" : iFunction = .MIN
- Case "PRODUCT" : iFunction = .PRODUCT
- Case "COUNTNUMS": iFunction = .COUNTNUMS
- Case "STDEV" : iFunction = .STDEV
- Case "STDEVP" : iFunction = .STDEVP
- Case "VAR" : iFunction = .VAR
- Case "VARP" : iFunction = .VARP
- Case "MEDIAN" : iFunction = .MEDIAN
- Case Else
- If Not ScriptForge.SF_Utils._Validate(sFunction, "DataFields/Function", V_STRING _
- , Array("Sum", "Count", "Average", "Max", "Min", "Product", "CountNums" _
- , "StDev", "StDevP", "Var", "VarP", "Median") _
- ) Then GoTo Finally
- End Select
- End With
- oField.Function2 = iFunction
- End If
- Next i
- ' Remove any pivot table with same name
- If oPivotTables.hasByName(PivotTableName) Then oPivotTables.removeByName(PivotTableName)
- ' Finalize the new pivot table
- oDescriptor.ShowFilterButton = FilterButton
- oDescriptor.RowGrand = RowTotals
- oDescriptor.ColumnGrand = ColumnTotals
- oPivotTables.insertNewByName(PivotTableName, oTargetAddress.XCellRange.getCellByPosition(0, 0).CellAddress, oDescriptor)
- ' Determine the range of the new pivot table
- Set oOutputRange = oPivotTables.getByName(PivotTableName).OutputRange
- With oOutputRange
- sPivotTable = _Component.getSheets().getCellRangeByPosition(.StartColumn, .StartRow, .EndColumn, .EndRow, .Sheet).AbsoluteName
- End With
- Finally:
- CreatePivotTable = sPivotTable
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.CreatePivotTable
- 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 ' SFDocuments.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 as a Long
- ''' Examples:
- ''' Val = oDoc.DCount("~.A1:A1000")
- Try:
- DCount = _DFunction("DCount", Range)
- Finally:
- Exit Function
- End Function ' SFDocuments.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 ' SFDocuments.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 ' SFDocuments.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 ' SFDocuments.SF_Calc.DSum
- REM -----------------------------------------------------------------------------
- Public Function ExportRangeToFile(Optional ByVal Range As Variant _
- , Optional ByVal FileName As Variant _
- , Optional ByVal ImageType As Variant _
- , Optional ByVal Overwrite As Variant _
- ) As Boolean
- ''' Store the given range as an image to the given file location
- ''' Actual selections are not impacted
- ''' Inspired by https://stackoverflow.com/questions/30509532/how-to-export-cell-range-to-pdf-file
- ''' Args:
- ''' Range: sheet name or cell range to be exported, as a string
- ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
- ''' ImageType: the name of the targeted media type
- ''' Allowed values: jpeg, pdf (default) and png
- ''' Overwrite: True if the destination file may be overwritten (default = False)
- ''' Returns:
- ''' False if the document could not be saved
- ''' Exceptions:
- ''' RANGEEXPORTERROR The destination has its readonly attribute set or overwriting rejected
- ''' Examples:
- ''' oDoc.ExportRangeToFile('SheetX.B2:J15", "C:\Me\Range2.png", ImageType := "png", Overwrite := True)
- Dim bSaved As Boolean ' return value
- Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
- Dim sFile As String ' Alias of FileName
- Dim vStoreArguments As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim FSO As Object ' SF_FileSystem
- Dim vImageTypes As Variant ' Array of permitted image types
- Dim vFilters As Variant ' Array of corresponding filters in the same order as vImageTypes
- Dim sFilter As String ' The filter to apply
- Dim oSelect As Object ' Currently selected range(s)
- Dim oAddress As Object ' Alias of Range
- Const cstImageTypes = "jpeg,pdf,png"
- Const cstFilters = "calc_jpg_Export,calc_pdf_Export,calc_png_Export"
- Const cstThisSub = "SFDocuments.Calc.ExportRangeToFile"
- Const cstSubArgs = "Range, FileName, [ImageType=""pdf""|""jpeg""|""png""], [Overwrite=False]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
- bSaved = False
- Check:
- If IsMissing(ImageType) Or IsEmpty(ImageType) Then ImageType = "pdf"
- If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
- vImageTypes = Split(cstImageTypes, ",")
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(ImageType, "ImageType", V_STRING, vImageTypes) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
- End If
- ' Check destination file overwriting
- Set FSO = CreateScriptService("FileSystem")
- sFile = FSO._ConvertToUrl(FileName)
- If FSO.FileExists(FileName) Then
- If Overwrite = False Then GoTo CatchError
- Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess")
- If oSfa.isReadonly(sFile) Then GoTo CatchError
- End If
- Try:
- ' Setup arguments
- vFilters = Split(cstFilters, ",")
- sFilter = vFilters(ScriptForge.SF_Array.IndexOf(vImageTypes, ImageType, CaseSensitive := False))
- Set oAddress = _ParseAddress(Range)
- ' The filter arguments differ between
- ' 1) pdf : store range in Selection property value
- ' 2) png, jpeg : save current selection, select range, restore initial selection
- If LCase(ImageType) = "pdf" Then
- vFilterData = Array(ScriptForge.SF_Utils._MakePropertyValue("Selection", oAddress.XCellRange) )
- vStoreArguments = Array( _
- ScriptForge.SF_Utils._MakePropertyValue("FilterName", sFilter) _
- , ScriptForge.SF_Utils._MakePropertyValue("FilterData", vFilterData) _
- )
- Else ' png, jpeg
- ' Save the current selection(s)
- Set oSelect = _Component.CurrentController.getSelection()
- _Component.CurrentController.select(oAddress.XCellRange)
- vStoreArguments = Array( _
- ScriptForge.SF_Utils._MakePropertyValue("FilterName", sFilter) _
- , ScriptForge.SF_Utils._MakePropertyValue("SelectionOnly", True) _
- )
- End If
- ' Apply the filter and export
- _Component.storeToUrl(sFile, vStoreArguments)
- If LCase(ImageType) <> "pdf" Then _RestoreSelections(_Component, oSelect)
- bSaved = True
- Finally:
- ExportRangeToFile = bSaved
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchError:
- ScriptForge.SF_Exception.RaiseFatal(RANGEEXPORTERROR, "FileName", FileName, "Overwrite", Overwrite)
- GoTo Finally
- End Function ' SFDocuments.SF_Chart.ExportRangeToFile
- REM -----------------------------------------------------------------------------
- Public Function Forms(Optional ByVal SheetName As Variant _
- , Optional ByVal Form As Variant _
- ) As Variant
- ''' Return either
- ''' - the list of the Forms contained in the given sheet
- ''' - a SFDocuments.Form object based on its name or its index
- ''' Args:
- ''' SheetName: the name of the sheet containing the requested form or forms
- ''' Form: a form stored in the document given by its name or its index
- ''' When absent, the list of available forms is returned
- ''' To get the first (unique ?) form stored in the form document, set Form = 0
- ''' Exceptions:
- ''' CALCFORMNOTFOUNDERROR Form not found
- ''' Returns:
- ''' A zero-based array of strings if Form is absent
- ''' An instance of the SF_Form class if Form exists
- ''' Example:
- ''' Dim myForm As Object, myList As Variant
- ''' myList = oDoc.Forms("ThisSheet")
- ''' Set myForm = oDoc.Forms("ThisSheet", 0)
- Dim oForm As Object ' The new Form class instance
- Dim oMainForm As Object ' com.sun.star.comp.sdb.Content
- Dim oXForm As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
- Dim vFormNames As Variant ' Array of form names
- Dim oForms As Object ' Forms collection
- Const cstDrawPage = -1 ' There is no DrawPages collection in Calc sheets
- Const cstThisSub = "SFDocuments.Calc.Forms"
- Const cstSubArgs = "SheetName, [Form=""""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If IsMissing(Form) Or IsEmpty(Form) Then Form = ""
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
- End If
- Try:
- ' Start from the Calc sheet and go down to forms
- Set oForms = _Component.getSheets.getByName(SheetName).DrawPage.Forms
- vFormNames = oForms.getElementNames()
- If Len(Form) = 0 Then ' Return the list of valid form names
- Forms = vFormNames
- Else
- If VarType(Form) = V_STRING Then ' Find the form by name
- If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally
- Set oXForm = oForms.getByName(Form)
- Else ' Find the form by index
- If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound
- Set oXForm = oForms.getByIndex(Form)
- End If
- ' Create the new Form class instance
- Set oForm = SF_Register._NewForm(oXForm)
- With oForm
- Set .[_Parent] = [Me]
- ._SheetName = SheetName
- ._FormType = ISCALCFORM
- Set ._Component = _Component
- ._Initialize()
- End With
- Set Forms = oForm
- End If
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchNotFound:
- ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent())
- End Function ' SFDocuments.SF_Calc.Forms
- 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 _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 ' SFDocuments.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)
- ElseIf Len(ObjectName) = 0 Then
- GetProperty = _PropertyGet(PropertyName)
- Else
- GetProperty = _PropertyGet(PropertyName, ObjectName)
- 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 _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 ' SFDocuments.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.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#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 _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 a range of cells, 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 _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 _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 Calc service as an array
- Methods = Array( _
- "A1Style" _
- , "Charts" _
- , "ClearAll" _
- , "ClearFormats" _
- , "ClearValues" _
- , "CopySheet" _
- , "CopySheetFromFile" _
- , "CopyToCell" _
- , "CopyToRange" _
- , "CreateChart" _
- , "DAvg" _
- , "DCount" _
- , "DMax" _
- , "DMin" _
- , "DSum" _
- , "ExportRangeToFile" _
- , "GetColumnName" _
- , "GetFormula" _
- , "GetValue" _
- , "ImportFromCSVFile" _
- , "ImportFromDatabase" _
- , "InsertSheet" _
- , "MoveRange" _
- , "MoveSheet" _
- , "Offset" _
- , "OpenRangeSelector" _
- , "Printf" _
- , "PrintOut" _
- , "RemoveSheet" _
- , "RenameSheet" _
- , "SetArray" _
- , "SetCellStyle" _
- , "SetFormula" _
- , "SetValue" _
- , "ShiftDown" _
- , "ShiftLeft" _
- , "ShiftRight" _
- , "ShiftUp" _
- , "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
- ''' If given as a range of cells, 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.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 _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 _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 _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 ' SFDocuments.SF_Calc.Offset
- REM -----------------------------------------------------------------------------
- Public Function OpenRangeSelector(Optional ByVal Title As Variant _
- , Optional ByVal Selection As Variant _
- , Optional ByVal SingleCell As Variant _
- , Optional ByVal CloseAfterSelect As Variant _
- ) As String
- ''' Activates the Calc document, opens a non-modal dialog with a text box,
- ''' let the user make a selection in the current or another sheet and
- ''' returns the selected area as a string.
- ''' This method does not change the current selection.
- ''' Args:
- ''' Title: the title to display on the top of the dialog
- ''' Selection: a default preselection as a String. When absent, the first element of the
- ''' current selection is preselected.
- ''' SingleCell: When True, only a single cell may be selected. Default = False
- ''' CloseAfterSelect: When True (default-, the dialog is closed immediately after
- ''' the selection. When False, the user may change his/her mind and must close
- ''' the dialog manually.
- ''' Returns:
- ''' The selected range as a string, or the empty string when the user cancelled the request (close window button)
- ''' Exceptions:
- ''' Examples:
- ''' Dim sSelect As String, vValues As Variant
- ''' sSelect = oDoc.OpenRangeSelector("Select a range ...")
- ''' If sSelect = "" Then Exit Function
- ''' vValues = oDoc.GetValue(sSelect)
- Dim sSelector As String ' Return value
- Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
- Dim oSelection As Object ' The current selection before opening the selector
- Dim oAddress As Object ' Preselected address as _Address
- Const cstThisSub = "SFDocuments.Calc.OpenRangeSelector"
- Const cstSubArgs = "[Title=""""], [Selection=""~""], [SingleCell=False], [CloseAfterSelect=True]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSelector = ""
- Check:
- If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
- If IsMissing(Selection) Or IsEmpty(Selection) Then Selection = "~"
- If IsMissing(SingleCell) Or IsEmpty(SingleCell) Then SingleCell = False
- If IsMissing(CloseAfterSelect) Or IsEmpty(CloseAfterSelect) Then CloseAfterSelect = True
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Title, "Title", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Selection, "Selection", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SingleCell, "SingleCell", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(CloseAfterSelect, "CloseAfterSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
- End If
- Try:
- ' Save the current selections
- Set oSelection = _Component.CurrentController.getSelection()
- ' Process preselection and select its containing sheet
- Set oAddress = _ParseAddress(Selection)
- Activate(oAddress.SheetName)
- ' Build arguments array and execute the dialog box
- With ScriptForge.SF_Utils
- vPropertyValues = Array( _
- ._MakePropertyValue("Title", Title) _
- , ._MakePropertyValue("CloseOnMouseRelease", CloseAfterSelect) _
- , ._MakePropertyValue("InitialValue", oAddress.XCellRange.AbsoluteName) _
- , ._MakePropertyValue("SingleCellMode", SingleCell) _
- )
- End With
- sSelector = SF_DocumentListener.RunRangeSelector(_Component, vPropertyValues)
- ' Restore the saved selections
- _RestoreSelections(_Component, oSelection)
- Finally:
- OpenRangeSelector = sSelector
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.OpenRangeSelector
- REM -----------------------------------------------------------------------------
- Public Function Printf(Optional ByVal InputStr As Variant _
- , Optional ByVal Range As Variant _
- , Optional ByVal TokenCharacter As Variant _
- ) As String
- ''' Returns the input string after substitution of its tokens by
- ''' their values in the given range
- ''' This method is usually used in combination with SetFormula()
- ''' The accepted tokens are:
- ''' - %S The sheet name containing the range, including single quotes when necessary
- ''' - %R1 The row number of the topleft part of the range
- ''' - %C1 The column letter of the topleft part of the range
- ''' - %R2 The row number of the bottomright part of the range
- ''' - %C2 The column letter of the bottomright part of the range
- ''' Args:
- ''' InputStr: usually a Calc formula or a part of a formula, but may be any string
- ''' Range: the range, as a string from which the values of the tokens are derived
- ''' TokenCharacter: the character identifying tokens. Default = "%".
- ''' Double the TokenCharacter to not consider it as a token.
- ''' Returns:
- ''' The input string after substitution of the contained tokens
- ''' Exceptions:
- ''' Examples:
- ''' Assume we have in A1:E10 a matrix of numbers. To obtain the sum by row in F1:F10 ...
- ''' Dim range As String, formula As String
- ''' range = "$A$1:$E$10")
- ''' formula = "=SUM($%C1%R1:$%C2%R1)" ' "=SUM($A1:$E1)", note the relative references
- ''' oDoc.SetFormula("$F$1:$F$10", formula)
- ''' 'F1 will contain =Sum($A1:$E1)
- ''' 'F2 =Sum($A2:$E2)
- ''' ' ...
- Dim sPrintf As String ' Return value
- Dim vSubstitute As Variants ' Array of strings representing the token values
- Dim oAddress As Object ' A range as an _Address object
- Dim sSheetName As String ' The %S token value
- Dim sC1 As String ' The %C1 token value
- Dim sR1 As String ' The %R1 token value
- Dim sC2 As String ' The %C2 token value
- Dim sR2 As String ' The %R2 token value
- Dim i As Long
- Const cstPseudoToken = "@#@"
- Const cstThisSub = "SFDocuments.Calc.Printf"
- Const cstSubArgs = "InputStr, Range, TokenCharacter=""%"""
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sPrintf = ""
- Check:
- If IsMissing(TokenCharacter) Or IsEmpty(TokenCharacter) Then TokenCharacter = "%"
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TokenCharacter, "TokenCharacter", V_STRING) Then GoTo Finally
- End If
- Try:
- ' Define the token values
- Set oAddress = _ParseAddress(Range)
- With oAddress.XCellRange
- sC1 = _GetColumnName(.RangeAddress.StartColumn + 1)
- sR1 = CStr(.RangeAddress.StartRow + 1)
- sC2 = _GetColumnName(.RangeAddress.EndColumn + 1)
- sR2 = CStr(.RangeAddress.EndRow + 1)
- sSheetName = _QuoteSheetName(oAddress.XSpreadsheet.Name)
- End With
- ' Substitute tokens by their values
- sPrintf = ScriptForge.SF_String.ReplaceStr(InputStr _
- , Array(TokenCharacter & TokenCharacter _
- , TokenCharacter & "R1" _
- , TokenCharacter & "C1" _
- , TokenCharacter & "R2" _
- , TokenCharacter & "C2" _
- , TokenCharacter & "S" _
- , cstPseudoToken _
- ) _
- , Array(cstPseudoToken _
- , sR1 _
- , sC1 _
- , sR2 _
- , sC2 _
- , sSheetName _
- , TokenCharacter _
- ) _
- )
- Finally:
- Printf = sPrintf
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.Printf
- REM -----------------------------------------------------------------------------
- Public Function PrintOut(Optional ByVal SheetName As Variant _
- , Optional ByVal Pages As Variant _
- , Optional ByVal Copies As Variant _
- ) As Boolean
- ''' Send the content of the given sheet to the printer.
- ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
- ''' Args:
- ''' SheetName: the sheet to print. Default = the active sheet
- ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
- ''' Copies: the number of copies
- ''' Returns:
- ''' True when successful
- ''' Examples:
- ''' oDoc.PrintOut("SheetX", "1-4;10;15-18", Copies := 2)
- Dim bPrint As Boolean ' Return value
- Dim oSheet As Object ' SheetName as a reference
- Const cstThisSub = "SFDocuments.Calc.PrintOut"
- Const cstSubArgs = "[SheetName=""~""], [Pages=""""], [Copies=1]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bPrint = False
- Check:
- If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
- If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
- If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not _ValidateSheet(SheetName, "SheetName", , True, True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- If SheetName = "~" Then SheetName = ""
- ' Make given sheet active
- If Len(SheetName) > 0 Then
- With _Component
- Set oSheet = .getSheets.getByName(SheetName)
- Set .CurrentController.ActiveSheet = oSheet
- End With
- End If
- bPrint = [_Super].PrintOut(Pages, Copies, _Component)
- Finally:
- PrintOut = bPrint
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.PrintOut
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the Calc class as an array
- Properties = Array( _
- "CurrentSelection" _
- , "CustomProperties" _
- , "Description" _
- , "DocumentProperties" _
- , "DocumentType" _
- , "ExportFilters" _
- , "FirstCell" _
- , "FirstColumn" _
- , "FirstRow" _
- , "Height" _
- , "ImportFilters" _
- , "IsBase" _
- , "IsCalc" _
- , "IsDraw" _
- , "IsImpress" _
- , "IsMath" _
- , "IsWriter" _
- , "Keywords" _
- , "LastCell" _
- , "LastColumn" _
- , "LastRow" _
- , "Range" _
- , "Readonly" _
- , "Region" _
- , "Sheet" _
- , "SheetName" _
- , "Sheets" _
- , "Subject" _
- , "Title" _
- , "Width" _
- , "XCellRange" _
- , "XComponent" _
- , "XSheetCellCursor" _
- , "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 _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 _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 _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 ' SFDocuments.SF_Calc.SetArray
- REM -----------------------------------------------------------------------------
- Public Function SetCellStyle(Optional ByVal TargetRange As Variant _
- , Optional ByVal Style As Variant _
- , Optional ByVal FilterFormula As Variant _
- , Optional ByVal FilterScope As Variant _
- ) As String
- ''' Apply the given cell style in the given range
- ''' If the cell style does not exist, an error is raised
- ''' The range is updated and the remainder of the sheet is left untouched
- ''' Either the full range is updated or a selection based on a FilterFormula
- ''' Args:
- ''' TargetRange : the range as a string that should receive a new cell style
- ''' Style: the style name as a string
- ''' FilterFormula: a Calc formula to select among the given Range
- ''' When left empty, all the cells of the range are formatted with the new style
- ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
- ''' When FilterFormula is present, FilterScope is mandatory
- ''' Returns:
- ''' A string representing the updated range
- ''' Examples:
- ''' oDoc.SetCellStyle("A1:F1", "Heading 2")
- ''' oDoc.SetCellStype("A1:J20", "Wrong", "=(A1<0)", "CELL")
- 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
- Dim vRanges() As Variant ' Array of filtered ranges
- Dim i As Long
- Const cstStyle = "CellStyles"
- Const cstThisSub = "SFDocuments.Calc.SetCellStyle"
- Const cstSubArgs = "TargetRange, Style, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sSet = ""
- Check:
- If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
- If IsMissing(FilterScope) Or IsEmpty(FilterScope) Then FilterScope = "CELL"
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
- ' Check that the given style really exists
- 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
- ' Filter formula
- If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
- If Len(FilterFormula) > 0 Then
- If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
- End If
- End If
- Try:
- If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
- With oAddress
- If Len(FilterFormula) = 0 Then ' When the full range should be updated
- .XCellRange.CellStyle = Style
- Else ' When the range has to be cut in subranges
- vRanges() = _ComputeFilter(oAddress, FilterFormula, UCase(FilterScope))
- For i = 0 To UBound(vRanges)
- vRanges(i).XCellRange.CellStyle = Style
- Next i
- End If
- sSet = .RangeName
- End With
- Finally:
- SetCellStyle = sSet
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' SFDocuments.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.XSpreadsheet.Name)
- 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 _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) 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:
- If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = 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 ' SFDocuments.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 o.XSpreadsheet.Name)f 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 _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 ' SFDocuments.SF_Calc.SetValue
- REM -----------------------------------------------------------------------------
- Public Function ShiftDown(Optional ByVal Range As Variant _
- , Optional ByVal WholeRow As Variant _
- , Optional ByVal Rows As Variant _
- ) As String
- ''' Move a specified range and all cells below in the same columns downwards by inserting empty cells
- ''' The inserted cells can span whole rows or be limited to the width of the range
- ''' The height of the inserted area is provided by the Rows argument
- ''' Nothing happens if the range shift crosses one of the edges of the worksheet
- ''' The execution of the method has no effect on the current selection
- ''' Args:
- ''' Range: the range above which cells have to be inserted, as a string
- ''' WholeRow: when True (default = False), insert whole rows
- ''' Rows: the height of the area to insert. Default = the height of the Range argument
- ''' Returns:
- ''' A string representing the new location of the initial range
- ''' Examples:
- ''' newrange = oDoc.ShiftDown("SheetX.A1:F10") ' "$SheetX.$A$11:$F$20"
- ''' newrange = oDoc.ShiftDown("SheetX.A1:F10", Rows := 3) ' "$SheetX.$A$4:$F$13"
- Dim sShift As String ' Return value
- Dim oSourceAddress As Object ' Alias of Range as _Address
- Dim lHeight As Long ' Range height
- Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
- Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
- Const cstThisSub = "SFDocuments.Calc.ShiftDown"
- Const cstSubArgs = "Range, [WholeRow=False], [Rows]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sShift = ""
- Check:
- If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
- If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Range)
- With oSourceAddress
- ' Manage the height of the area to shift
- ' The insertCells() method inserts a number of rows equal to the height of the cell range to shift
- lHeight = .Height
- If Rows <= 0 Then Rows = lHeight
- If _LastCell(.XSpreadsheet)(1) + Rows > MAXROWS Then GoTo Catch
- If Rows <> lHeight Then
- Set oShiftAddress = _Offset(oSourceAddress, 0, 0, Rows, 0).XCellRange.RangeAddress
- Else
- Set oShiftAddress = .XCellRange.RangeAddress
- End If
- ' Determine the shift mode
- With com.sun.star.sheet.CellInsertMode
- If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .DOWN
- End With
- ' Move the cells as requested. This modifies .XCellRange
- .XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
- ' Determine the receiving area
- sShift = .XCellRange.AbsoluteName
- End With
- Finally:
- ShiftDown = sShift
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' When error, return the original range
- If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.ShiftDown
- REM -----------------------------------------------------------------------------
- Public Function ShiftLeft(Optional ByVal Range As Variant _
- , Optional ByVal WholeColumn As Variant _
- , Optional ByVal Columns As Variant _
- ) As String
- ''' Delete the leftmost columns of a specified range and move all cells at their right leftwards
- ''' The deleted cells can span whole columns or be limited to the height of the range
- ''' The width of the deleted area is provided by the Columns argument
- ''' The execution of the method has no effect on the current selection
- ''' Args:
- ''' Range: the range in which cells have to be erased, as a string
- ''' WholeColumn: when True (default = False), erase whole columns
- ''' Columns: the width of the area to delete.
- ''' Default = the width of the Range argument, it is also its maximum value
- ''' Returns:
- ''' A string representing the location of the remaining part of the initial range,
- ''' or the zero-length string if the whole range has been deleted
- ''' Examples:
- ''' newrange = oDoc.ShiftLeft("SheetX.G1:L10") ' """
- ''' newrange = oDoc.ShiftLeft("SheetX.G1:L10", Columns := 3) ' "$SheetX.$G$1:$I$10"
- Dim sShift As String ' Return value
- Dim oSourceAddress As Object ' Alias of Range as _Address
- Dim lWidth As Long ' Range width
- Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
- Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
- Const cstThisSub = "SFDocuments.Calc.ShiftLeft"
- Const cstSubArgs = "Range, [WholeColumn=False], [Columns]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sShift = ""
- Check:
- If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
- If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Range)
- Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
- With oSourceAddress
- ' Manage the width of the area to delete
- ' The removeRange() method erases a number of columns equal to the width of the cell range to delete
- lWidth = .Width
- If Columns <= 0 Then Columns = lWidth
- If Columns < lWidth Then
- Set oShiftAddress = _Offset(oSourceAddress, 0, 0, 0, Columns).XCellRange.RangeAddress
- Else ' Columns is capped at the range width
- Set oShiftAddress = .XCellRange.RangeAddress
- End If
- ' Determine the Delete mode
- With com.sun.star.sheet.CellDeleteMode
- If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .LEFT
- End With
- ' Move the cells as requested. This modifies .XCellRange
- .XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
- ' Determine the remaining area
- If Columns < lWidth Then sShift = .XCellRange.AbsoluteName
- End With
- Finally:
- ShiftLeft = sShift
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' When error, return the original range
- If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.ShiftLeft
- REM -----------------------------------------------------------------------------
- Public Function ShiftRight(Optional ByVal Range As Variant _
- , Optional ByVal WholeColumn As Variant _
- , Optional ByVal Columns As Variant _
- ) As String
- ''' Move a specified range and all next cells in the same rows to the right by inserting empty cells
- ''' The inserted cells can span whole columns or be limited to the height of the range
- ''' The width of the inserted area is provided by the Columns argument
- ''' Nothing happens if the range shift crosses one of the edges of the worksheet
- ''' The execution of the method has no effect on the current selection
- ''' Args:
- ''' Range: the range before which cells have to be inserted, as a string
- ''' WholeColumn: when True (default = False), insert whole columns
- ''' Columns: the width of the area to insert. Default = the width of the Range argument
- ''' Returns:
- ''' A string representing the new location of the initial range
- ''' Examples:
- ''' newrange = oDoc.ShiftRight("SheetX.A1:F10") ' "$SheetX.$G$1:$L$10"
- ''' newrange = oDoc.ShiftRight("SheetX.A1:F10", Columns := 3) ' "$SheetX.$D$1:$I$10"
- Dim sShift As String ' Return value
- Dim oSourceAddress As Object ' Alias of Range as _Address
- Dim lWidth As Long ' Range width
- Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
- Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
- Const cstThisSub = "SFDocuments.Calc.ShiftRight"
- Const cstSubArgs = "Range, [WholeColumn=False], [Columns]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sShift = ""
- Check:
- If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
- If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Range)
- With oSourceAddress
- ' Manage the width of the area to Shift
- ' The insertCells() method inserts a number of columns equal to the width of the cell range to Shift
- lWidth = .Width
- If Columns <= 0 Then Columns = lWidth
- If _LastCell(.XSpreadsheet)(0) + Columns > MAXCOLS Then GoTo Catch
- If Columns <> lWidth Then
- Set oShiftAddress = _Offset(oSourceAddress, 0, 0, 0, Columns).XCellRange.RangeAddress
- Else
- Set oShiftAddress = .XCellRange.RangeAddress
- End If
- ' Determine the Shift mode
- With com.sun.star.sheet.CellInsertMode
- If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .RIGHT
- End With
- ' Move the cells as requested. This modifies .XCellRange
- .XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
- ' Determine the receiving area
- sShift = .XCellRange.AbsoluteName
- End With
- Finally:
- ShiftRight = sShift
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' When error, return the original range
- If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.ShiftRight
- REM -----------------------------------------------------------------------------
- Public Function ShiftUp(Optional ByVal Range As Variant _
- , Optional ByVal WholeRow As Variant _
- , Optional ByVal Rows As Variant _
- ) As String
- ''' Delete the topmost rows of a specified range and move all cells below upwards
- ''' The deleted cells can span whole rows or be limited to the width of the range
- ''' The height of the deleted area is provided by the Rows argument
- ''' The execution of the method has no effect on the current selection
- ''' Args:
- ''' Range: the range in which cells have to be erased, as a string
- ''' WholeRow: when True (default = False), erase whole rows
- ''' Rows: the height of the area to delete.
- ''' Default = the height of the Range argument, it is also its maximum value
- ''' Returns:
- ''' A string representing the location of the remaining part of the initial range,
- ''' or the zero-length string if the whole range has been deleted
- ''' Examples:
- ''' newrange = oDoc.ShiftUp("SheetX.G1:L10") ' ""
- ''' newrange = oDoc.ShiftUp("SheetX.G1:L10", Rows := 3) ' "$SheetX.$G$1:$I$10"
- Dim sShift As String ' Return value
- Dim oSourceAddress As Object ' Alias of Range as _Address
- Dim lHeight As Long ' Range height
- Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right height
- Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
- Const cstThisSub = "SFDocuments.Calc.ShiftUp"
- Const cstSubArgs = "Range, [WholeRow=False], [Rows]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sShift = ""
- Check:
- If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
- If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive(True) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
- End If
- Try:
- Set oSourceAddress = _ParseAddress(Range)
- Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
- With oSourceAddress
- ' Manage the height of the area to delete
- ' The removeRange() method erases a number of rows equal to the height of the cell range to delete
- lHeight = .Height
- If Rows <= 0 Then Rows = lHeight
- If Rows < lHeight Then
- Set oShiftAddress = _Offset(oSourceAddress, 0, 0, Rows, 0).XCellRange.RangeAddress
- Else ' Rows is capped at the range height
- Set oShiftAddress = .XCellRange.RangeAddress
- End If
- ' Determine the Delete mode
- With com.sun.star.sheet.CellDeleteMode
- If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .UP
- End With
- ' Move the cells as requested. This modifies .XCellRange
- .XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
- ' Determine the remaining area
- If Rows < lHeight Then sShift = .XCellRange.AbsoluteName
- End With
- Finally:
- ShiftUp = sShift
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- ' When error, return the original range
- If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
- GoTo Finally
- End Function ' SFDocuments.SF_Calc.ShiftUp
- 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. Default = False
- ''' 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""], [DestinationCell=""""], [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 _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", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", ScriptForge.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
- vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
- vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
- vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
- If Len(DestinationCell) = 0 Then
- vSortDescriptor = 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
- vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True)
- vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
- End If
- vSortDescriptor = 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
- vSortDescriptor = 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 ' SFDocuments.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 ExportFilters() As Variant
- ExportFilters = [_Super].GetProperty("ExportFilters")
- End Property ' SFDocuments.SF_Calc.ExportFilters
- REM -----------------------------------------------------------------------------
- Property Get ImportFilters() As Variant
- ImportFilters = [_Super].GetProperty("ImportFilters")
- End Property ' SFDocuments.SF_Calc.ImportFilters
- 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 Function CreateMenu(Optional ByVal MenuHeader As Variant _
- , Optional ByVal Before As Variant _
- , Optional ByVal SubmenuChar As Variant _
- ) As Object
- Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar)
- End Function ' SFDocuments.SF_Calc.CreateMenu
- REM -----------------------------------------------------------------------------
- Public Function ExportAsPDF(Optional ByVal FileName As Variant _
- , Optional ByVal Overwrite As Variant _
- , Optional ByVal Pages As Variant _
- , Optional ByVal Password As Variant _
- , Optional ByVal Watermark As Variant _
- ) As Boolean
- ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark)
- End Function ' SFDocuments.SF_Calc.ExportAsPDF
- REM -----------------------------------------------------------------------------
- Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
- RemoveMenu = [_Super].RemoveMenu(MenuHeader)
- End Function ' SFDocuments.SF_Calc.RemoveMenu
- REM -----------------------------------------------------------------------------
- Public Sub RunCommand(Optional ByVal Command As Variant _
- , ParamArray Args As Variant _
- )
- [_Super].RunCommand(Command, Args)
- 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 -----------------------------------------------------------------------------
- Public Function SetPrinter(Optional ByVal Printer As Variant _
- , Optional ByVal Orientation As Variant _
- , Optional ByVal PaperFormat As Variant _
- ) As Boolean
- SetPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat)
- End Function ' SFDocuments.SF_Calc.SetPrinter
- REM =========================================================== PRIVATE FUNCTIONS
- REM -----------------------------------------------------------------------------
- Private Sub _ClearRange(ByVal psTarget As String _
- , Optional ByVal Range As Variant _
- , Optional FilterFormula As Variant _
- , Optional FilterScope As Variant _
- )
- ''' Clear the given range with the given options
- ''' The range may be filtered by a formula for a selective clearance
- ''' Arguments checking is done in this Sub, not in the calling one
- ''' Args:
- ''' psTarget: "All", "Formats" or "Values"
- ''' Range: the range to clear as a string
- ''' FilterFormula: a selection of cells based on a Calc formula
- ''' When left empty, all the cells of the range are cleared
- ''' psFilterScope: "CELL", "ROW" or "COLUMN"
- Dim lClear As Long ' A combination of com.sun.star.sheet.CellFlags
- Dim oRange As Object ' Alias of Range
- Dim vRanges() As Variant ' Array of subranges resulting from the application of the filter
- Dim i As Long
- Dim cstThisSub As String : cstThisSub = "SFDocuments.Calc.Clear" & psTarget
- Const cstSubArgs = "Range, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
- If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Check:
- If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
- If IsMissing(FilterScope) Or IsEmpty(FilterScope) Then FilterScope = "CELL"
- If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not _IsStillAlive() Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(Range, "Range", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
- If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
- If Len(FilterFormula) > 0 Then
- If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
- Else
- If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
- End If
- End If
- Try:
- With com.sun.star.sheet.CellFlags
- Select Case psTarget
- Case "All"
- lClear = .VALUE + .DATETIME + .STRING + .ANNOTATION + .FORMULA _
- + .HARDATTR + .STYLES + .OBJECTS + .EDITATTR + .FORMATTED
- Case "Formats"
- lClear = .HARDATTR + .STYLES + .EDITATTR + .FORMATTED
- Case "Values"
- lClear = .VALUE + .DATETIME + .STRING + .FORMULA
- End Select
- End With
- If VarType(Range) = V_STRING Then Set oRange = _ParseAddress(Range) Else Set oRange = Range
- ' Without filter, the whole range is cleared
- ' Otherwise the filter cuts the range in subranges and clears them one by one
- If Len(FilterFormula) = 0 Then
- oRange.XCellRange.clearContents(lClear)
- Else
- vRanges() = _ComputeFilter(oRange, FilterFormula, UCase(FilterScope))
- For i = 0 To UBound(vRanges)
- vRanges(i).XCellRange.clearContents(lClear)
- Next i
- End If
- Finally:
- ScriptForge.SF_Utils._ExitFunction(cstThisSub)
- Exit Sub
- Catch:
- GoTo Finally
- End Sub ' SFDocuments.SF_Calc._ClearRange
- REM -----------------------------------------------------------------------------
- Private Function _ComputeFilter(ByRef poRange As Object _
- , ByVal psFilterFormula As String _
- , ByVal psFilterScope As String _
- ) As Variant
- ''' Compute in the given range the cells, rows or columns for which
- ''' the given formula returns TRUE
- ''' Args:
- ''' poRange: the range on which to compute the filter as an _Address type
- ''' psFilterFormula: the formula to be applied on each row, column or cell
- ''' psFilterSCope: "ROW", "COLUMN" or "CELL"
- ''' Returns:
- ''' An array of ranges as objects of type _Address
- Dim vRanges As Variant ' Return value
- Dim oRange As Object ' A single vRanges() item
- Dim lLast As Long ' Last used row or column number in the sheet containing Range
- Dim oFormulaRange As _Address ' Range where the FilterFormula must be stored
- Dim sFormulaDirection As String ' Either V(ertical), H(orizontal) or B(oth)
- Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
- Dim vFilter As Variant ' Array of Boolean values indicating which rows should be erased
- Dim bFilter As Boolean ' A single item in vFilter
- Dim iDims As Integer ' Number of dimensions of vFilter()
- Dim lLower As Long ' Lower level of contiguous True filter values
- Dim lUpper As Long ' Upper level of contiguous True filter values
- Dim i As Long, j As Long
- Check:
- ' Error handling is determined by the calling method
- vRanges = Array()
- Try:
- With poRange
- ' Compute the range where to apply the formula
- ' Determine the direction of the range containing the formula vertical, horizontal or both
- Select Case psFilterScope
- Case "ROW"
- lLast = LastColumn(.SheetName)
- ' Put formulas as a single column in the unused area at the right of the range to filter
- Set oFormulaRange = _Offset(poRange, 0, lLast - .XCellRange.RangeAddress.StartColumn + 1, 0, 1)
- sFormulaDirection = "V"
- Case "COLUMN"
- lLast = LastRow(.SheetName)
- ' Put formulas as a single row in the unused area at the bottom of the range to filter
- Set oFormulaRange = _Offset(poRange, lLast - .XCellRange.RangeAddress.StartRow + 1, 0, 1, 0)
- sFormulaDirection = "H"
- Case "CELL"
- lLast = LastRow(.SheetName)
- ' Put formulas as a matrix in the unused area at the bottom of the range to filter
- Set oFormulaRange = _Offset(poRange, lLast - .XCellRange.RangeAddress.StartRow + 1, 0, 0, 0)
- sFormulaDirection = "B"
- If oFormulaRange.Width = 1 Then
- sFormulaDirection = "V"
- ElseIf oFormulaRange.Height = 1 Then
- sFormulaDirection = "H"
- End If
- End Select
- ' Apply the formula and get the result as an array of Boolean values. Clean up
- SetFormula(oFormulaRange, psFilterFormula)
- vDataArray = oFormulaRange.XCellRange.getDataArray()
- vFilter = _ConvertFromDataArray(vDataArray)
- iDims = ScriptForge.SF_Array.CountDims(vFilter)
- ClearAll(oFormulaRange)
- ' Convert the filter values (0 = False, 1 = True) to a set of ranges
- Select Case iDims
- Case -1 ' Scalar
- If vFilter = 1 Then vRanges = ScriptForge.SF_Array.Append(vRanges, poRange)
- Case 0 ' Empty array
- ' Nothing to do
- Case 1, 2 ' Vector or Array
- ' Strategy: group contiguous applicable rows/columns to optimize heavy operations like CompactUp, CompactLeft
- ' Stack the contiguous ranges of True values in vRanges()
- ' To manage vector and array with same code, setup a single fictitious loop when vector, otherwise scan array by row
- For i = 0 To Iif(iDims = 1, 0, UBound(vFilter, 1))
- lLower = -1 : lUpper = -1
- For j = 0 To UBound(vFilter, iDims)
- If iDims = 1 Then bFilter = CBool(vFilter(j)) Else bFilter = CBool(vFilter(i, j))
- If j = UBound(vFilter, iDims) And bFilter Then ' Don't forget the last item
- If lLower < 0 Then lLower = j
- lUpper = j
- ElseIf Not bFilter Then
- If lLower >= 0 Then lUpper = j - 1
- ElseIf bFilter Then
- If lLower < 0 Then lLower = j
- End If
- ' Determine the next applicable range when one found and limit reached
- If lUpper > -1 Then
- If sFormulaDirection = "V" Then ' ROW
- Set oRange = _Offset(poRange, lLower, 0, lUpper - lLower + 1, 0)
- ElseIf sFormulaDirection = "H" Then ' COLUMN
- Set oRange = _Offset(poRange, 0, lLower, 0, lUpper - lLower + 1)
- Else ' CELL
- Set oRange = _Offset(poRange, i, lLower, 1, lUpper - lLower + 1)
- End If
- If Not IsNull(oRange) Then vRanges = ScriptForge.SF_Array.Append(vRanges, oRange)
- lLower = -1 : lUpper = -1
- End If
- Next j
- Next i
- Case Else
- ' Should not happen
- End Select
- End With
- Finally:
- _ComputeFilter = vRanges()
- Exit Function
- End Function ' SFDocuments.SF_Calc._ComputeFilter
- 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 ' SFDocuments.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 ' SFDocuments.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
- ''' Input may be a 1D array of arrays, typically when call issued by a Python script
- ''' 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 (1) of input array
- Dim lMax1 As Long ' Upper bound (1)
- Dim lMin2 As Long ' Lower bound (2)
- Dim lMax2 As Long ' Upper bound (2)
- Dim lRows As Long ' Upper bound of vDataArray
- Dim lCols As Long ' Upper bound of vVector
- Dim bHorizontal As Boolean ' Horizontal vector
- Dim bDataArray As Boolean ' Input array is already an array of arrays
- 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 )
- bDataArray = IsArray(pvArray(0))
- If Not bDataArray Then
- If Not bHorizontal Then
- lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
- Else
- lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray)
- End If
- Else
- iDims = 2
- lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
- lMin2 = LBound(pvArray(0)) : lMax2 = UBound(pvArray(0))
- 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
- If bDataArray Then
- vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2))
- Else
- vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2))
- End If
- End Select
- vVector(j) = vItem
- End If
- vDataArray(i) = vVector
- Next j
- Next i
- Finally:
- _ConvertToDataArray = vDataArray
- Exit Function
- End Function ' SFDocuments.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 _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 ' SFDocuments.SF_Calc._DFunction
- REM -----------------------------------------------------------------------------
- Private Function _FileIdent() As String
- ''' Returns a file identification from the information that is currently available
- ''' Useful e.g. for display in error messages
- _FileIdent = [_Super]._FileIdent()
- End Function ' SFDocuments.SF_Calc._FileIdent
- REM -----------------------------------------------------------------------------
- Function _GetColumnName(ByVal plColumnNumber As Long) As String
- ''' Convert a column number (range 1, 2,..16384) into its letter counterpart (range 'A', 'B',..'XFD').
- ''' Args:
- ''' ColumnNumber: the column number, must be in the interval 1 ... 16384
- ''' Returns:
- ''' a string representation of the column name, in range 'A'..'XFD'
- ''' 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:
- sCol = ""
- lDiv = plColumnNumber
- Do While lDiv > 0
- lMod = (lDiv - 1) Mod 26
- sCol = Chr(65 + lMod) & sCol
- lDiv = (lDiv - lMod) \ 26
- Loop
- Finally:
- _GetColumnName = sCol
- End Function ' SFDocuments.SF_Calc._GetColumnName
- REM -----------------------------------------------------------------------------
- Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
- , Optional ByVal pbError As Boolean _
- ) As Boolean
- ''' Returns True if the document has not been closed manually or incidentally since the last use
- ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
- ''' Args:
- ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
- ''' pbError: if True (default), raise a fatal error
- Dim bAlive As Boolean ' Return value
- If IsMissing(pbForUpdate) Then pbForUpdate = False
- If IsMissing(pbError) Then pbError = True
- Try:
- bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError)
- Finally:
- _IsStillAlive = bAlive
- Exit Function
- End Function ' SFDocuments.SF_Calc._IsStillAlive
- 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
- .ServiceName = SERVICEREFERENCE
- .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 ' SFDocuments.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 Object ' Return value
- Dim sAddress As String ' Alias of psAddress
- Dim vRangeName As Variant ' Array Sheet/Range
- 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
- ' If psAddress has already been parsed, get the result back
- If Not IsNull(_LastParsedAddress) Then
- ' Given argument must contain an explicit reference to a sheet
- If (InStr(psAddress, "~.") = 0 And InStr(psAddress, ".") > 0 And psAddress = _LastParsedAddress.RawAddress) _
- Or psAddress = _LastParsedAddress.RangeName Then
- Set _ParseAddress = _LastParsedAddress
- Exit Function
- Else
- Set _LastParsedAddress = Nothing
- End If
- End If
- ' Reinitialize a new _Address object
- Set oAddress = New _Address
- With oAddress
- sSheet = "" : sRange = ""
- .SheetName = "" : .RangeName = ""
- .ObjectType = CALCREFERENCE
- .ServiceName = SERVICEREFERENCE
- .RawAddress = psAddress
- Set .XSpreadSheet = Nothing : Set .XCellRange = Nothing
- ' Remove leading "$' when followed with an apostrophe
- If Left(psAddress, 2) = "$'" Then sAddress = Mid(psAddress, 2) Else sAddress = psAddress
- ' Split in sheet and range components on dot not enclosed in single quotes
- vRangeName = ScriptForge.SF_String.SplitNotQuoted(sAddress, Delimiter := ".", QuoteChar := "'")
- sSheet = ScriptForge.SF_String.Unquote(Replace(vRangeName(0), "''", "\'"), QuoteChar := "'")
- ' Keep a leading "$" in the sheet name only if name enclosed in single quotes
- ' Notes:
- ' sheet names may contain "$" (even "$" is a valid sheet name), named ranges must not
- ' sheet names may contain apostrophes (except in 1st and last positions), range names must not
- If Left(vRangeName(0), 2) <> "'$" And Left(sSheet, 1) = "$" And Len(sSheet) > 1 Then sSheet = Mid(sSheet, 2)
- If UBound(vRangeName) > 0 Then sRange = vRangeName(1)
- ' 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 = .XCellRange.AbsoluteName
- .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
- ' Store last parsed address for reuse
- Set _LastParsedAddress = oAddress
- 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 oAddress As Object ' _Address type for range description
- Dim oCursor As Object ' com.sun.star.sheet.XSheetCellCursor
- Dim i As Long
- Dim cstThisSub As String
- Const cstSubArgs = ""
- _PropertyGet = False
- cstThisSub = "SFDocuments.Calc.get" & psProperty
- ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- If Not _IsStillAlive() Then GoTo Finally
- Select Case UCase(psProperty)
- Case UCase("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 UCase("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 UCase("FirstCell"), UCase("FirstRow"), UCase("FirstColumn") _
- , UCase("LastCell"), UCase("LastColumn"), UCase("LastRow") _
- , UCase("SheetName")
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then ' Avoid errors when instance is watched in Basic IDE
- If InStr(UCase(psProperty), "CELL") > 0 Then _PropertyGet = "" Else _PropertyGet = -1
- Else
- If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
- Set oAddress = _ParseAddress(pvArg)
- With oAddress.XCellRange
- Select Case UCase(psProperty)
- Case UCase("FirstCell")
- _PropertyGet = A1Style(.RangeAddress.StartRow + 1, .RangeAddress.StartColumn + 1, , , oAddress.XSpreadsheet.Name)
- Case UCase("FirstColumn") : _PropertyGet = CLng(.RangeAddress.StartColumn + 1)
- Case UCase("FirstRow") : _PropertyGet = CLng(.RangeAddress.StartRow + 1)
- Case UCase("LastCell")
- _PropertyGet = A1Style(.RangeAddress.EndRow + 1, .RangeAddress.EndColumn + 1, , , oAddress.XSpreadsheet.Name)
- Case UCase("LastColumn") : _PropertyGet = CLng(.RangeAddress.EndColumn + 1)
- Case UCase("LastRow") : _PropertyGet = CLng(.RangeAddress.EndRow + 1)
- Case UCase("SheetName") : _PropertyGet = oAddress.XSpreadsheet.Name
- End Select
- End With
- End If
- Case UCase("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 UCase("Region")
- If IsMissing(pvArg) Or IsEmpty(pvArg) Then
- _PropertyGet = ""
- Else
- If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
- Set oAddress = _ParseAddress(pvArg)
- With oAddress
- Set oCursor = .XSpreadsheet.createCursorByRange(.XCellRange)
- oCursor.collapseToCurrentRegion()
- _PropertyGet = oCursor.AbsoluteName
- End With
- End If
- Case UCase("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 UCase("Sheets")
- _PropertyGet = _Component.getSheets.getElementNames()
- Case UCase("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 UCase("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 UCase("XSheetCellCursor")
- 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 oAddress = _ParseAddress(pvArg)
- Set _PropertyGet = oAddress.XSpreadsheet.createCursorByRange(oAddress.XCellRange)
- End If
- Case UCase("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 _QuoteSheetName(ByVal psSheetName As String) As String
- ''' Return the given sheet name surrounded with single quotes
- ''' when required to insert the sheet name into a Calc formula
- ''' Enclosed single quotes are doubled
- ''' Args:
- ''' psSheetName: the name to quote
- ''' Returns:
- ''' The quoted or unchanged sheet name
- Dim sSheetName As String ' Return value
- Dim i As Long
- Try:
- ' Surround the sheet name with single quotes when required by the presence of single quotes
- If InStr(psSheetName, "'") > 0 Then
- sSheetName = "'" & Replace(psSheetName, "'", "''") & "'"
- Else
- ' Surround the sheet name with single quotes when required by the presence of at least one of the special characters
- sSheetName = psSheetName
- For i = 1 To Len(cstSPECIALCHARS)
- If InStr(sSheetName, Mid(cstSPECIALCHARS, i, 1)) > 0 Then
- sSheetName = "'" & sSheetName & "'"
- Exit For
- End If
- Next i
- End If
- Finally:
- _QuoteSheetName = sSheetName
- Exit Function
- End Function ' SFDocuments.SF_Calc._QuoteSheetName
- 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 _
- , Optional ByVal pvResetSheet As Variant _
- ) As Boolean
- ''' Sheet designation validation function similar to the SF_Utils._ValidateXXX functions
- ''' Args:
- ''' pvSheetName: string or numeric position
- ''' pvArgName: the name of the variable to be used in the error message
- ''' 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
- ''' pvResetSheet: if True, return in pvSheetName the correct (case-sensitive) sheet name (default = False)
- ''' 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 lSheet As Long ' Index in 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
- If IsMissing(pvResetSheet) Or IsEmpty(pvResetSheet) Then pvResetSheet = 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
- ' ScriptForge.SF_String.FindRegex(sAddress, "^'[^\[\]*?:\/\\]+'")
- 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
- If pvResetSheet Then
- lSheet = ScriptForge.SF_Array.IndexOf(vSheets, pvSheetName, CaseSensitive := False)
- pvSheetName = vSheets(lSheet)
- End If
- 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 -----------------------------------------------------------------------------
- Private Function _ValidateSheetName(ByRef psSheetName As String _
- , ByVal psArgName As String _
- ) As Boolean
- ''' Check the validity of the sheet name:
- ''' A sheet name - must not be empty
- ''' - must not contain next characters: []*?:/\
- ''' - must not use ' (the apostrophe) as first or last character
- ''' Args:
- ''' psSheetName: the name to check
- ''' psArgName: the name of the argument to appear in error messages
- ''' Returns:
- ''' True when the sheet name is valid
- ''' Exceptions:
- ''' CALCADDRESSERROR ' Sheet name could not be parsed to a valid name
- Dim bValid As Boolean ' Return value
- Try:
- bValid = ( Len(psSheetName) > 0 )
- If bValid Then bValid = ( Left(psSheetName, 1) <> "'" And Right(psSheetName, 1) <> "'" )
- If bValid Then bValid = ( Len(ScriptForge.SF_String.FindRegex(psSheetName, "^[^\[\]*?:\/\\]+$", 1, CaseSensitive := False)) > 0 )
- If Not bValid Then GoTo CatchSheet
- Finally:
- _ValidateSheetName = bValid
- Exit Function
- CatchSheet:
- ScriptForge.SF_Exception.RaiseFatal(CALCADDRESSERROR, psArgName, psSheetName _
- , "Document", [_Super]._FileIdent())
- GoTo Finally
- End Function ' SFDocuments.SF_Calc._ValidateSheetName
- REM ============================================ END OF SFDOCUMENTS.SF_CALC
- </script:module>
|