je me suis fais une bonne grosse macro calc pour pouvoir historiser un compte bancaire (banque populaire) à partir d'extractions CSV issues de l'interface web. Ca gère une forme de catégorisation automatique, ainsi que les éventuels recouvrements des extractions.
à toutes fins utiles ...
Code : Tout sélectionner
' ===============================================================================================
' (very simple) bank account management: imports a CSV text file (extraction of the bank webapp),
' filters the new lines, and categorizes them.
' NB: for the moment, the dialogs are in french. I'll see maybe later for i18n.
' ===============================================================================================
' Copyright (C) 2006 Frédéric Besnard (fbe314 (at) gmail.com)
'
' This library is free software; you can redistribute it and/or modify it under the terms of the
' GNU Lesser General Public License as published by the Free Software Foundation; either
' version 2.1 of the License, or (at your option) any later version.
' This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
' without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
' Anyone may run this code. If you wish to modify or distribute this code, then you are granted
' a license to do so only under the terms of the Gnu Lesser General Public License.
' See: http://www.gnu.org/licenses/lgpl.html or http://www.opensource.org/licenses/lgpl-license.php
' ===============================================================================================
Public const Version="1.0"
option explicit
dim acteurs() as string ' names we want to extract from each bank operation label
dim categ() as string ' the category of the name
dim solde0 as integer ' the initial amount of money
dim sht ' the sheet containing data
dim folder as string ' folder containing csv files
Sub Main
print "utilisez les boutons de la feuille 'compte' !"
end sub
sub debug(obj)
print "props = " ,obj.DBG_properties
print "methods = ",obj.DBG_methods
print "interf = " ,obj.DBG_supportedInterfaces
end sub
' main button: reads files, and integrates data
' ---------------------------------------------
sub integrer
initParams()
importCSV()
manageDuplicatedRows(false) 'true=select, false=remove
updateNewLines()
end sub
' initializes global parameters:
' reads somes values (cells and columns) from the firt sheet knowing their names
' ------------------------------------------------------------------------------
sub initParams
if not isEmpty(sht) then ' ensure that this proc is called only once
exit sub
end if
dim paramsSheet' com.sun.star.sheet.XSpreadSheet
dim shtname as string
paramsSheet = ThisComponent.sheets.getByIndex(0) ' params are in the first sheet
sht = ThisComponent.sheets.getByIndex(1) ' data are in the second one
acteurs = stringsBelow( paramsSheet, "Acteur" )
categ = stringsBelow( paramsSheet, "Catégorie" )
solde0 = namedCellToString( paramsSheet, "solde0" )
folder = namedCellToString( paramsSheet, "folder" )
end sub
' return an array of the strings contained in the cells below a named cell
' ------------------------------------------------------------------------
function stringsBelow( sheet, headCellName as string )
dim adr ' com.sun.star.table.CellRangeAddress
adr = sheet.getCellRangeByName(headCellName).getRangeAddress()
dim t(99) as string
dim i as integer
i = -1
do
i = i+1
t(i) = sheet.getCellByPosition( adr.startColumn, adr.startRow+1+i ).string
loop while t(i) <> ""
redim preserve t(i)
stringsBelow = t()
end function
' return an array of the string contained in a named column in a sheet
' (no more used - replaced by stringsBelow() - left here just for example )
' -------------------------------------------------------------------------
function namedColumnToStringArray( sheetname, colname as string )
dim zone, n, irow
zone = sheetname.getCellRangeByName(colname)
' using getDataArray could have been nice ... but it returns a list of rows
n = zone.rows.count
dim result( n )
for irow = 0 to n-1
result(irow) = zone.getCellByPosition(0,irow).string
next irow
namedColumnToStringArray = result()
end function
' return the string value contained into a named cell in a sheet
' --------------------------------------------------------------
function namedCellToString( sheet , cellname as string ) as string
namedCellToString = sheet.getCellRangeByName(cellname).getCellByPosition(0,0).string
end function
' update all the lines - a priori, seldomly used -. Called by a button
' ------------------------------------------------------------------
sub updateAllLines
initParams()
updateLineFrom(3)
end sub
' this procedure has to be called after importCSV() and then "selectDuplicatedRows()"
' have been deleted (by hand by the user)
' The new block has its first column empty. To find the first line to update,
' we go to the end of the whole block (including new one), and then go up
' until the first cell of the line is not empty
' -----------------------------------------------------------------------------------
sub updateNewLines ' called by a button
initParams()
dim n as integer
n = indexFirstEmptyLine()
' now, move up to find the first empty cell of the first column
' while isNull(sht.getCellByPosition(0,n).value) ' does not work
while sht.getCellByPosition(0,n).string = ""
n = n-1
wend
updateLineFrom(n+1)
end sub
' find the index of the first empty line
' --------------------------------------
function indexFirstEmptyLine as integer
dim cursor
cursor = sht.createCursor
cursor.gotoStart
cursor.gotoOffset(0,1) 'from the 2nd line
cursor.gotoEnd ' goto end of the filled cells block
indexFirstEmptyLine = cursor.getCellByPosition(0,0).rangeAddress.endRow + 1
end function
' update a sequence of lines, beginning at a given index
' ------------------------------------------------------
sub updateLineFrom(i as integer)
dim irow as integer
irow = i
while sht.getCellByPosition(1,irow).string <> ""
updateLine(irow)
irow = irow + 1
wend
end sub
type info
acteur as string
categ as string
end type
' update one line: compute the new order count (previous+1),
' balance (previous+current amount), actor, category, month and year.
' -------------------------------------------------------------------
sub updateLine(irow as integer)
dim nb, dateCompta, dateOp, libelle, montant, solde, mot, acteur, categg, annee, mois
dim nbHiers, soldeHiers
nb = sht.getCellByPosition(0,irow)
dateCompta = sht.getCellByPosition(1,irow)
dateOp = sht.getCellByPosition(2,irow)
libelle = sht.getCellByPosition(3,irow)
montant = sht.getCellByPosition(6,irow)
solde = sht.getCellByPosition(7,irow)
mot = sht.getCellByPosition(8,irow)
acteur = sht.getCellByPosition(9,irow)
categg = sht.getCellByPosition(10,irow)
annee = sht.getCellByPosition(11,irow)
mois = sht.getCellByPosition(12,irow)
nbHiers = sht.getCellByPosition(0,irow-1)
soldeHiers = sht.getCellByPosition(7,irow-1)
nb.value = nbHiers.value + 1
solde.value = soldeHiers.value + montant.value
mois.value = month(dateCompta.value)
mot.string = word1(libelle.string)
annee.value = year(dateCompta.value)
dim inf as info
inf = acteurAndCateg(libelle.string)
acteur.string = inf.acteur
' do not erase checks comments
if inf.acteur <> "CHEQUE" then
categg.string = inf.categ
end if
'if ubound(extract())>0 then
' if extract(1) <> "" then
' categg.string = extract(1)
' end if
'end if
end sub
' search in a string (libelle) the "actor", and returns it along with its category
' --------------------------------------------------------------------------------
function acteurAndCateg( s as string ) as info
' two cases: either it's a blue card bill ("facturette de carte bleue") - which means
' that the first word is "FAC" - , and the actor is what is between the first space after
' CB*....... and the first digit after,
' or not, and then any "actor" is searched in the "acteur" array, which is returned
' with its category.
' an example of libelle is "FAC 090704 CB*502XXX96 E. LECLERC DAC 06 NICE"
dim result as info
select case word1(s)
case "FAC"
dim indiceCB, i1, i2
indiceCB = instr(s,"CB")
i1 = instr( indiceCB, s, " " ) + 1
i2 = indexCar( i1, "0123456789", s )
result.acteur = Mid( s , i1, i2-i1 )
result.categ = "CB"
acteurAndCateg = result
case else
acteurAndCateg = qui(s)
end select
end function
' search occurrence of any string of "acteurs" array in the parameter.
' if found, returns the occurrence, along with its categ
' --------------------------------------------------------------------
function qui( s ) as info
dim i as integer
dim result as info
for i = 0 to ubound(acteurs())-1
'print i, acteurs(i)
if ( instr(s,acteurs(i)) <> 0 ) then
result.acteur = acteurs(i)
result.categ = categ(i)
qui = result
exit function
end if
next i
qui = result
end function
' import a CSV file
' -----------------
sub importCSV
initParams()
dim csv as string, l as integer
' csv = chooseFile(folder)
csv = FileOpenDialog(folder)
l = indexFirstEmptyLine() ' we set an empty line between old and new block
readCSV(csv,sht,false,1,l,";",1,"DDSSDN")
end sub
function FileOpenDialog(title as String) as String
dim filepicker, files
filepicker = createUnoService("com.sun.star.ui.dialogs.FilePicker")
filepicker.Title = title
filepicker.execute()
files = filepicker.getFiles()
FileOpenDialog=files(0)
End function
' i know there is an existing function in the API to read files,
' but i prefered to write my own one, better suited to my case,
' and also as a writing code exercice ...
' --------------------------------------------------------------
sub readCSV( filename as String,_
sheet as Variant,_
ascending as boolean,_
col1 as integer,_
ligne1 as integer,_
separateur as String,_
nl as integer,_
columnTypes as String )
' read each non empty line in an array, skipping the first 'nl' lines (headers)
dim lignes(555) as string, ligne as string
dim n,i,k as integer
dim f ' file
n = 0 ' line count
f = freefile
open filename for input as f
for i = 1 to nl
line input #f, ligne
next i
'read until end, skipping empty lines
do while not eof(f)
line input #f, ligne
if ligne <> "" then
lignes(n) = ligne
n = n + 1
end if
loop
close #f
' now the lines are in the array, i iterate from start to end (or the opposite,
' depending of "ascending"), and each line is splitted into fields, which are
' put into cell, with types given by "columnTypes"
for k = 1 to n
'choose wether to write lines ascending or descending
if ascending then
ligne = lignes(k)
else
ligne = lignes(n-k)
end if
dim champs() as string, s as string
dim car, cell
champs = split(ligne,separateur)
for i = 0 to ubound(champs)-1 ' there is an empty field at the end of the line
cell = sheet.getCellByPosition(col1+i,ligne1+k)
car = Mid(columnTypes,i+1,1) ' what is the column's type ?
s = champs(i)
'print car & ":" & s
select case car
case "S" ' string
cell.string = s
case "N" ' number
cell.value = csng(s)
case "D" ' date
setDate(cell,s)
case else
print "unknown type"
end select
next i
next k
end sub
' set a date in a cell, in the local format
' -----------------------------------------
sub setDate( cell, dateString )
' convert french date (DD/MM/YYYY) to english one ( MM/DD/YYYY )
dim aday, amonth, ayear, newdate, oFormats, oLocale, nDateKey
aday = mid(dateString,1,2)
amonth = mid(dateString,4,2)
ayear = mid(dateString, 7,len(dateString))
newDate = amonth & "/" & aday & "/" & ayear
oFormats = ThisComponent.getNumberFormats()
oLocale = createUnoStruct( "com.sun.star.lang.Locale" )
nDateKey = oFormats.getStandardFormat( com.sun.star.util.NumberFormat.DATE, oLocale )
cell.formula = newDate
cell.NumberFormat = nDateKey
end sub
sub testDate
dim cell1,cell2
cell1 = ThisComponent.sheets().getByName("test").getCellByPosition(0,0)
cell2 = ThisComponent.sheets().getByName("test").getCellByPosition(0,1)
setDate(cell1,"20/02/2005")
setDate(cell2,"21/02/2005")
print cell1.value & " " & cell2.value & " " & (cell1.value<cell2.value)
End Sub
' return the index of the first of any characters of "chars" in "inWhat" starting at "startIndex"
' -----------------------------------------------------------------------------------------------
function indexCar( startIndex as integer, chars as string , inWhat as string ) as integer
dim i as integer, c
for i = startIndex to len(inWhat)
c = mid(inWhat,i,1) ' car of index i
if ( instr(chars,c) <> 0 ) then
indexCar = i
exit function
end if
next i
indexCar = 0
end function
' the first word in a string (if no space found, the whole string itself)
' -----------------------------------------------------------------------
function word1( s as string ) as string
dim indexSpace
indexSpace = instr(s, " ")
if indexSpace = 0 then
word1 = s
else
word1 = left( s, indexSpace-1)
end if
end function
' utility function, to shorten an often used call
' -----------------------------------------------
function cellPos( icol as integer, irow as integer ) ' returns cell
cellPos = sht.getCellByPosition( icol, irow )
end function
sub selectDuplicateRows
manageDuplicatedRows(true)
end sub
' after having imported csv, select the duplicated rows to be deleted (by hand):
' this file may contains rows that are overlaping existing ones
' -----------------------------------------------------------------------------
sub manageDuplicatedRows( wantsToSelect as boolean )
initParams()
'csv data block is inserted after the first block, with a blank line in between.
'first, let's find the date and label of the end row of the first block
dim n as integer, adate, alabel
n = indexFirstEmptyLine()-1
adate = cellPos(1,n).value
alabel = cellPos(3,n).string
'then, let's go on the following empty line (which has to be selected to be deleted later)
n = n+1
dim indexEmptyLine
indexEmptyLine = n
'move forward while the curent date < adate
while cellPos(1,n).value < adate
n = n+1
wend
' for all the possible lines having the same date,
' there is two cases: either one of these lines has the same label,
' and then only the following lines have to be kept, or there is no occurrence
' of this label, and then all the lines must be kept.
' In either cases, all lines with greater dates have to be kept.
dim indexLineOfSameLabel
indexLineOfSameLabel = -1 ' by default, not found
while cellPos(1,n).value = adate
if cellPos(3,n).string = alabel then
indexLineOfSameLabel = n
end if
n = n+1
wend
dim indexLastLine
if indexLineOfSameLabel <> -1 then
indexLastLine = indexLineOfSameLabel
else
indexLastLine = n-1
end if
if wantsToSelect then
dim range
' range = sht.getRows(indexEmptyLine)
range = sht.getCellRangeByPosition(0,indexEmptyLine,255,indexLastLine)
ThisComponent.CurrentController.Select(range)
else ' wants to remove
sht.rows.removeByIndex( indexEmptyLine, indexLastLine-indexEmptyLine+1 )
end if
end sub