Numbers : tableaux croisés dynamiques (2)

-- ©2010 TG for MacNOMODO users
-- All rights reserved.
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
-- Redistributions of source code must retain the above copyright
-- notice, this list of conditions and the following disclaimer.
-- Redistributions in binary form must reproduce the above copyright
-- notice, this list of conditions and the following disclaimer in the
-- documentation and/or other materials provided with the distribution.
-- Neither the name of TG or MacNOMODO may be used to endorse or
-- promote products derived from this software without specific prior
-- written permission.
--
-- THIS SOFTWARE IS PROVIDED BY TG AND MacNOMODO ``AS IS'' AND ANY
-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL TG AND MacNOMODO BE LIABLE FOR ANY
-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
-- ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

set strDialogTitle to "Tableau croisé"
set strDataRange to "Plage de données à prendre en compte :"
set strRangeError to " : la plage indiquée est invalide."
set str1or2dimensions to "Combien de dimensions souhaitez-vous analyser ?"
set strFirstDimension to "Colonne de la première dimension :"
set strSecondDimension to "Colonne de la seconde dimension :"
set strInvalidDimension to " : la colonne indiquée est invalide."
set strOutOfRangeDimension to " : la colonne indiquée est hors plage."
set strWhichFunction to "Quelle fonction de comptage voulez-vous utiliser ?"
set strNB to "NB"
set strSUM to "SOMME"
set SUMIFS to "=SOMME.SIS("
set COUNTIFS to "=NB.SIS("
set INDEX1 to "=INDEX("
set INDEX2 to ";SI(ESTERREUR(EQUIV("
set INDEX3 to "EQUIV("
set SUM to "=SOMME("
set strDataColumn to "Colonne contenant les données à additionner :"
set strTitleSize to "Combien y a-t-il de lignes de titre ?"
set strResultDest to "Placer le résultat dans :"
set strNewTable to "Nouvelle table"
set strNewSheet to "Nouvelle feuille"
set strNoSelection to "Sélectionnez une plage de cellules et recommencez..."

set A2 to missing value
set B1 to missing value
set B2 to missing value

tell application "Numbers"
   tell document 1
      set noSelection to true
      repeat with s from 1 to the count of sheets
         tell sheet s
            repeat with t from 1 to the count of tables
               if the (count of cells) of the selection range of table t is not 0 then
                  set noSelection to false
                  tell table t
                     --try
                     if the (count of cells) of the selection range is 1 then
                        set selectionRange to (a reference to the cell range)
                     else
                        set selectionRange to (a reference to the selection range)
                     end if
                     --
                     -- saisie de la plage de données
                     --
                     set done to false
                     set strInvalidAnswer to ""
                     repeat until done
                        set dataRangeName to display dialog strInvalidAnswer & strDataRange ¬
                           default answer (the name of selectionRange) as text ¬
                           with title strDialogTitle
                        set dataRangeName to (text returned of dataRangeName)
                        try
                           set dataRangeFullName to name & "::" & dataRangeName
                           get (range dataRangeFullName)
                           set sourceRange to (a reference to range dataRangeFullName)
                           set done to true
                        on error
                           set strInvalidAnswer to (dataRangeName & strRangeError & return & return) as text
                           beep 2
                        end try
                     end repeat
                     if the (count of columns of sourceRange) is 1 then
                        set dims to 1
                        set dim1 to name of column 1 of sourceRange
                        set dim1N to address of column dim1
                     else
                        set dims to (button returned of (display dialog str1or2dimensions buttons {"1", "2"} with title strDialogTitle)) as integer
                        --
                        -- saisie de la première dimension
                        --
                        set done to false
                        set strInvalidAnswer to ""
                        repeat until done
                           set dim1 to display dialog strInvalidAnswer & strFirstDimension ¬
                              default answer first character of ((name of cell 1 of column 1 of sourceRange) as text) ¬
                              with title strDialogTitle & " (" & dataRangeFullName & ")"
                           set dim1 to (text returned of dim1)
                           try
                              set dim1N to address of column dim1
                              if dim1N < (address of first column of sourceRange) or dim1N > (address of last column of sourceRange) then
                                 beep 2
                                 set strInvalidAnswer to (dim1 & strOutOfRangeDimension & return & return) as text
                              else
                                 set done to true
                              end if
                           on error
                              set strInvalidAnswer to (dim1 & strInvalidDimension & return & return) as text
                              beep 2
                           end try
                        end repeat
                        if dims = 2 then
                           --
                           -- saisie de la seconde dimension
                           --
                           set done to false
                           set strInvalidAnswer to ""
                           repeat until done
                              set dim2 to display dialog strInvalidAnswer & strSecondDimension ¬
                                 default answer first character of ((name of cell 1 of column 2 of sourceRange) as text) ¬
                                 with title strDialogTitle & " (" & dataRangeFullName & ")"
                              set dim2 to (text returned of dim2)
                              try
                                 set dim2N to address of column dim2
                                 if dim2N < (address of first column of sourceRange) or dim2N > (address of last column of sourceRange) then
                                    beep 2
                                    set strInvalidAnswer to (dim2 & strOutOfRangeDimension & return & return) as text
                                 else
                                    set done to true
                                 end if
                              on error
                                 set strInvalidAnswer to (dim2 & strInvalidDimension & return & return) as text
                                 beep 2
                              end try
                           end repeat
                        end if
                     end if
                     set dataC to missing value
                     if the (count of columns of sourceRange) is not dims then
                        if button returned of (display dialog strWhichFunction buttons {strNB, strSUM} with title strDialogTitle) is strSUM then
                           --
                           -- saisie de la plage de données
                           --
                           set done to false
                           set strInvalidAnswer to ""
                           repeat until done
                              set dataC to display dialog strInvalidAnswer & strDataColumn ¬
                                 default answer first character of ((name of cell 1 of column (dims + 1) of sourceRange) as text) ¬
                                 with title strDialogTitle & " (" & dataRangeFullName & ")"
                              set dataC to (text returned of dataC)
                              try
                                 set dataN to address of column dataC
                                 if dataN < (address of first column of sourceRange) or dataN > (address of last column of sourceRange) then
                                    beep 2
                                    set strInvalidAnswer to (dataC & strOutOfRangeDimension & return & return) as text
                                 else
                                    set done to true
                                 end if
                              on error
                                 set strInvalidAnswer to (dataC & strInvalidDimension & return & return) as text
                                 beep 2
                              end try
                           end repeat
                        end if
                     end if
                     set headSize to (button returned of (display dialog strTitleSize buttons {"0", "1", "2"} with title strDialogTitle & " (" & dataRangeFullName & ")")) as integer
                     set firstLine to (address of first row of sourceRange) + headSize
                     set lastLine to address of last row of sourceRange
                     set xDim1 to name & "::$" & dim1 & "$" & firstLine & ":$" & dim1 & "$" & lastLine
                     if dataC is not missing value then
                        set xData to name & "::$" & dataC & "$" & firstLine & ":$" & dataC & "$" & lastLine
                     end if
                     set A2 to INDEX1 & xDim1 & INDEX2 & "$A1+0,0001;" & xDim1 & ";-1));" & INDEX3 & "$A1&\" \";" & xDim1 & ";-1);" & INDEX3 & "$A1+0,0001;" & xDim1 & ";-1));1)"
                     if dims is 1 then
                        if dataC is missing value then
                           set B2 to (COUNTIFS & xDim1 & ";$A2)") as text
                        else
                           set B2 to (SUMIFS & xData & ";" & xDim1 & ";$A2)") as text
                        end if
                     else
                        set xDim2 to name & "::$" & dim2 & "$" & firstLine & ":$" & dim2 & "$" & lastLine
                        set B1 to INDEX1 & xDim2 & INDEX2 & "A$1+0,0001;" & xDim2 & ";-1));" & INDEX3 & "A$1&\" \";" & xDim2 & ";-1);" & INDEX3 & "A$1+0,0001;" & xDim2 & ";-1));1)"
                        if dataC is missing value then
                           set B2 to (COUNTIFS & xDim1 & ";$A2;" & xDim2 & ";B$1)") as text
                        else
                           set B2 to (SUMIFS & xData & ";" & xDim1 & ";$A2;" & xDim2 & ";B$1)") as text
                        end if
                     end if
                     --on error
                     --   return "giving up"
                     --end try
                  end tell
               end if
            end repeat
            if A2 is not missing value then
               set dest to missing value
               if (button returned of (display dialog strResultDest buttons {strNewTable, strNewSheet} with title strDialogTitle)) as text is strNewTable then
                  set dest to make new table
               end if
            end if
         end tell
      end repeat
      if A2 is not missing value then
         if dest is missing value then
            set dest to make new sheet
            set dest to (a reference to table 1 of dest)
         end if
         set masksheet to make new sheet
         repeat while the (count of rows of dest) > 2
            delete last row of dest
         end repeat
         repeat while the (count of columns of dest) > 2
            delete last column of dest
         end repeat
         set the value of cell "A2" of dest to A2
         set the value of cell "B1" of dest to B1
         set the value of cell "B2" of dest to B2
         set done to false
         repeat until done
            add row below last row of dest
            if the value of last cell of column 1 of dest is 0 then
               set done to true
            end if
         end repeat
         set the value of last cell of column 1 of dest to "Total"
         set the value of last cell of column 2 of dest to SUM & name of cell 2 of column 2 of dest & ":" & name of cell ((count of cells of column 2 of dest) - 1) of column 2 of dest & ")"
         set done to false
         repeat until done
            add column after last column of dest
            if the value of last cell of row 1 of dest is 0 then
               set done to true
            end if
         end repeat
         set the value of last cell of row 1 of dest to "Total"
         repeat with r from 2 to (count of cells of column 2 of dest)
            set the value of last cell of row r of dest to SUM & name of cell 2 of row r of dest & ":" & name of cell ((count of cells of row r of dest) - 1) of row r of dest & ")"
         end repeat
         delete masksheet
      end if
      if noSelection then
         beep
         display alert strNoSelection as informational
      end if
   end tell
end tell