[Calc] Import de données de compte bancaire en CSV

Vos meilleures macros et portions de code sont publiées dans cette section.
Aucun support sur une question de programmation ici !

Modérateur : Vilains modOOs

Règles du forum
Aucune question dans cette section !
Celle-ci rassemble les meilleures macros et portions de code. Vous pouvez en revanche commenter ou argumenter le code exposé. Vous pouvez même remercier l'auteur (cela fait toujours plaisir) en indiquant par exemple dans quel cadre ou contexte vous en avez eu l'utilité.
Si vous avez à poster quelque chose, faites-le depuis la section Macros et API et demandez à un modérateur de l'y déplacer.
fb314
Fraîchement OOthentifié
Messages : 5
Inscription : 20 janv. 2008 18:10

[Calc] Import de données de compte bancaire en CSV

Message par fb314 »

hello,

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

OpenOffice 2.3.1 sous kubuntu 07.10
frn8cky
NOOuvel adepte
NOOuvel adepte
Messages : 12
Inscription : 22 janv. 2008 17:54

Message par frn8cky »

merci
je regarde tout ça...
OpenOffice 2.4.0 sous Windows XP SP2
Verrouillé