Ask Your Question
0

referencing values across multiple files

asked 2017-07-30 16:56:43 +0200

sleeperstakes gravatar image

I have a template document (.ots) with a macro that exports and saves the new file as .ods to a desired location. What i want to do is create a new document that gives me the average values across all the exported files, given that the number of files it'll need to reference will increase as i use the template document more often so there will be more exported files over time. Is there any way to do this, like "average all the values in this given range on all the .ods documents in this folder"

edit retag flag offensive close merge delete

1 Answer

Sort by » oldest newest most voted
0

answered 2017-08-01 00:35:44 +0200

librebel gravatar image

Hello @sleeperstakes,

the following macro returns the average of all the values in a given range on all the .ods documents in a given folder:

REM  *****  BASIC  *****
Option Explicit

Function AverageFolder( strFolderPath As String, strCellRanges As String, Optional bCountBlankAsZero As Boolean ) As Double
REM Returns the average of the given CellRanges in all spreadsheet files within a given Folder.
REM <strFolderPath>:    The full path to the Folder containing the spreadsheet files.
REM                     This string should end with the path separator ( e.g. "/home/username/Desktop/MyFolder/" ).
REM <strCellRanges>:    String representing the CellRanges to be averaged.
REM                     NB. The Sheet Name should be included for each CellRange, e.g. "Sheet1.A1:D5;Sheet2.A1:D5".
REM                     NB. All referenced sheets must be present in all the spreadsheets within the given folder.
REM <bCountBlankAsZero>:    [OPTIONAL] Boolean indicating if Empty cells should be counted as 0 in the sum.
REM                         True = Empty cells are counted as 0;
REM                         False ( = Default ) = Empty cells are not counted in the sum.
REM Example call from Calc: =AVERAGEFOLDER( "/home/username/Desktop/MyFolder/"; "$Sheet1.$A$1:$D$5"; 1 )
On Local Error Resume Next
    Dim oFileAccess as Object
    oFileAccess = createUnoService( "com.sun.star.ucb.SimpleFileAccess" )

    If oFileAccess.Exists( strFolderPath ) AND oFileAccess.IsFolder( strFolderPath ) Then

        Dim oFunctionAccess As Object
        oFunctionAccess = createUnoService( "com.sun.star.sheet.FunctionAccess" )

        Dim sFiles() As String
        sFiles = oFileAccess.getFolderContents( strFolderPath, False )  REM get files only.

        Dim aProps(0) As New com.sun.star.beans.PropertyValue   REM Open the file invisible.
        aProps(0).Name = "Hidden"
        aProps(0).Value = True

        Dim dSum as Double, dAverage As Double
        Dim lNum as Long, lCountBlank As Long
        Dim i As Integer, j As Integer
        Dim oDoc As Object

        For i = 0 to uBound( sFiles )

            oDoc = StarDesktop.loadComponentFromURL( sFiles(i), "_blank", 0, aProps() )
            If Not IsNull( oDoc ) Then

                REM Check if doc is a valid spreadsheet:
                If oDoc.supportsService( "com.sun.star.sheet.SpreadsheetDocument" ) Then

                    Dim aCellRanges() as Object
                    REM This next line yields an IllegalArgument exception when <strCellRanges>
                    REM contains a Sheet name that is not actually present in the spreadsheet.
                    REM In that case this Function returns ZERO ( 0 ),
                    REM ... provided that the line "On Local Error Resume Next" is not commented out.
                    aCellRanges = oDoc.getSheets().getCellRangesByName( strCellRanges )

                    If uBound( aCellRanges ) >= 0 Then
                        dSum = dSum + oFunctionAccess.CallFunction( "SUM", aCellRanges )
                        lNum = lNum + oFunctionAccess.CallFunction( "COUNTA", aCellRanges )
                        If Not IsMissing( bCountBlankAsZero ) And bCountBlankAsZero Then
                            REM COUNTBLANK wants a single range ...
                            For j = 0 To uBound( aCellRanges )
                                lNum = lNum + oFunctionAccess.CallFunction( "COUNTBLANK", Array( aCellRanges(j) ) )
                            Next j
                        End If
                    End If

                End If
                oDoc.Close( True )
            End If

        Next i
        AverageFolder = dSum / lNum
    End If
End Function

Virtually untested, please try if the above macro works for you...

With regards, lib

edit flag offensive delete link more

Comments

Thank you, you've been a life saver <3

sleeperstakes gravatar imagesleeperstakes ( 2017-08-01 00:53:52 +0200 )edit

you're welcome @sleeperstakes,

If this answers your question, then please click on the ✔ mark until it turns green ( at the upper left area of the answer ).

librebel gravatar imagelibrebel ( 2017-08-01 11:32:30 +0200 )edit
Login/Signup to Answer

Question Tools

1 follower

Stats

Asked: 2017-07-30 16:56:43 +0200

Seen: 45 times

Last updated: Aug 01 '17