logo ferr
Macros pour Calc

Bordure

Cellule

Colonne

Date

Feuille

Fichier

Filtre

Ligne

Tableau

Texte

Bordure
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub BordureGrille(document as object,num_feuille as integer,x1 as long,y1 as long,x2 as long,y2 as long, _
                  affiche as boolean,optional epaisseur as long, optional couleur as long)      

  'Affiche ou supprime une grille de bordures pour une plage de cellules

  '=> On ne peut pas directement écrire dans la structure TableBorder2.
  '   Il faut modifier une structure temporaire puis la transmettre
  
  'document    : classeur où se trouve la feuille
  'num_feuille : index de la feuille contenant la plage de cellules
  '(x1,y1)     : coin supérieur gauche de la plage de cellules. Exemple : A1=(0,0)
  '(x2,y2)     : coin inférieur droit de la plage de cellule. Exemple : E1=(4,0) 
  'affiche     : true pour afficher la grille, false pour la supprimer
  'epaisseur   : paramètre optionnel pour l'épaisseur du trait (en 1/100 de mm)
  'couleur     : paramètre optionnel pour la couleur du trait (noir par défaut)

  dim feuille         as object
  dim plageCellule    as object
  dim bordureActuelle as object
  dim bordureNouvelle as new com.sun.star.table.BorderLine2
  dim i               as integer

  feuille=document.Sheets(num_feuille)
  plageCellule=feuille.getCellRangeByPosition(x1,y1,x2,y2)
  
  bordureActuelle=plageCellule.TableBorder2      
  
  'Récupération des paramètres en cours
  
  bordureActuelle.ISLeftLineValid=true           
  bordureActuelle.ISRightLineValid=true
  bordureActuelle.ISTopLineValid=true
  bordureActuelle.ISBottomLineValid=true
  bordureActuelle.ISHorizontalLineValid=true
  bordureActuelle.ISVerticalLineValid=true
  
  'Prise en compte des paramètres optionnels
  
  if (affiche=true) then                         
    if IsMissing(couleur) then bordureNouvelle.color=0 else bordureNouvelle.color=couleur
    if IsMissing(epaisseur) then bordureNouvelle.LineWidth=5 else bordureNouvelle.LineWidth=epaisseur
  else
    bordureNouvelle.color=0
    bordureNouvelle.LineWidth=0
  endif  
  
  'Mise à jour des paramètres des bordures
  
  bordureActuelle.LeftLine=bordureNouvelle       
  bordureActuelle.RightLine=bordureNouvelle
  bordureActuelle.TopLine=bordureNouvelle
  bordureActuelle.BottomLine=bordureNouvelle
  bordureActuelle.HorizontalLine=bordureNouvelle
  bordureActuelle.VerticalLine=bordureNouvelle
 
  'Transmission des nouveaux paramètres
  
  plageCellule.TableBorder2=bordureActuelle     
end sub
Cellule
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub CelluleCentrer(document as object,num_feuille as integer,x as long, y as long)

  'Centre horizontalement le contenu de la  cellule

  ' document    : document dans lequel se trouve la cellule
  ' num_feuille : numéro de feuille du document  
  ' x,y         : colonne et ligne de la cellule (la numérotation débute à 0)
  
  dim cellule as object
  
  cellule=document.Sheets(num_feuille).GetCellByPosition(x,y)
  cellule.HoriJustify=com.sun.star.table.CellHoriJustify.CENTER
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub CelluleCopier(document as object,feuille1 as integer,x1 as long,y1 as long,x2 as long,y2 as long, _
                  feuille2 as integer,x3 as long,y3 as long)

  'Copie une plage de cellules (contenu, style et format) dans le même classeur
  'La numérotation des feuilles, des lignes et des colonnes débute à 0

  'document  : document contenant les cellules à copier
  'feuille1  : feuille contenant les cellules à copier
  '(x1,y1)   : coordonnées du coin supérieur gauche de la plage à copier
  '(x2,y2)   : coordonnées du coin inférieur droit de la plage à copier
  'feuille2  : feuille existante dans laquelle sont recopiées les cellules
  '(x3,y3)   : coordonnées du coin supérieur gauche de la feuille où la plage de cellules sera recopiée 

  dim adresse_source      as object
  dim adresse_destination as object
  dim feuille_source      as object
  dim feuille_destination as object
 
  feuille_source=document.Sheets(feuille1)
  adresse_source=feuille_source.getCellRangeByPosition(x1,y1,x2,y2).rangeAddress  'Sélection de la plage à copier
  feuille_destination=document.Sheets(feuille2)
  adresse_destination=feuille_destination.getCellByPosition(x3,y3).cellAddress    'Sélection de la cellule pour la recopie 
  feuille_destination.copyRange(adresse_destination,adresse_source)               'Recopie de la plage de cellules
end sub
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub CelluleEffacer(document as object,num_feuille as integer,x1 as long,y1 as long,optional x2 as long,optional y2 as long)

  ' Efface le contenu et la mise en forme d'une cellule ou d'une plage de cellules
  
  ' La hauteur et la largeur des cellules ne sont pas affectées.
  ' La numérotation des feuilles, des lignes et des colonnes débute à 0.

  ' En entrée
  '   document    : document contenant les cellules à effacer
  '   num_feuille : feuille contenant les cellules à effacer
  '   (x1,y1)     : coordonnées de la cellule à effacer ou du coin supérieur gauche de la plage de cellules à effacer
  '   (x2,y2)     : coordonnées du coin inférieur droit de la plage de cellules à effacer (optionnel)

  ' Pour tout effacer, il faut additionner les valeurs suivantes :
  ' -Valeur numérique=1
  ' -Date ou heure=2
  ' -Chaîne de caractères=4
  ' -Annotation=8
  ' -Formule=16
  ' -Mise en forme autre que celle via la feuille de style=32
  ' -Style de la cellule=64
  ' -Objet de dessin=128
  ' -Mise en forme du contenu de la cellule=256
  ' -Mise en forme dans la cellule=512
  
  dim feuille as object
  dim cellule as object
  
  feuille=document.sheets(num_feuille)
  if IsMissing(x2) or IsMissing(y2) then cellule=feuille.GetCellByPosition(x1,y1) else cellule=feuille.GetCellRangeByPosition(x1,y1,x2,y2)
  cellule.clearContents(1023)
end sub
Codé avec la version 7.0.3.1 (x64) de LibreOffice
Sub CelluleFiger(document as object,num_feuille as integer,x as long,y as long)

  'Fige les lignes et les colonnes précédant la cellule spécifiée d'une feuille visible
  
  'La numérotation des feuilles, lignes et colonnes débutent à 0.
  'Si x vaut 0, les colonnes sont libérées.
  'Si y vaut 0, les lignes sont libérées.
  
  'En entrée
    'document    : document contenant la feuille
    'num_feuille : index de la feuille  
    'x,y         : colonne et ligne de la cellule de référence 

  dim controleur as object
  dim feuille    as object

  feuille=document.sheets(num_feuille)
  controleur=document.CurrentController
  controleur.select(feuille)
  controleur.freezeAtPosition(x,y)
End Sub
Colonne
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub ColonneResultatFiltre(document as object,num_feuille as integer,x as long,y as long,resultat())

  ' Récupère dans le tableau resultat les valeurs affichées dans la colonne x après application d'un filtre
  
  ' Toutes les données sont récupérées à partir de la cellule (x,y). Les cellules vides sont ignorées.
  ' La numérotation des feuilles, des lignes et des colonnes débute à 0

  ' En entrée
  '   document    : document contenant les cellules à récupérer
  '   num_feuille : indice de la feuille contenant les cellules à récupérer
  '   (x,y)       : coordonnées de la première cellule à récupérer
  ' En sortie
  '   resultat    : tableau de type variant débutant à l'indice 0, rempli avec le contenu des cellules visibles et non vides ;
  '                 si le tableau est vide, ubound(resultat)=-1

  dim curseur                    as object  
  dim feuille                    as object
  dim groupe_plage_cellule       as object    'Ensemble des plages de cellules visibles après application du filtre
  dim plage_cellule_avant_filtre as object    'Ensemble des cellules avant application du filtre
  dim plage_cellule_apres_filtre as object    'Une des plages de cellules contenue dans groupe_plage_cellule
  dim i                          as long
  dim j                          as long
  dim k                          as long
  dim ligne_max                  as long
  dim nb_cellule                 as long
  dim aux                        as variant 
  
  feuille=document.Sheets(num_feuille)
  redim resultat()
  
  'Recherche de l'indice de la dernière ligne qui n'est pas vide, affichée ou non
  
  curseur=feuille.createCursor
  curseur.gotoEndOfUsedArea(false)
  ligne_max=curseur.RangeAddress.EndRow
  
  'Sélection des cellules visibles dans la colonne x
  
  plage_cellule_avant_filtre=feuille.getCellRangeByPosition(x,y,x,ligne_max)
  groupe_plage_cellule=plage_cellule_avant_filtre.queryVisibleCells()
  
  'Détermination du nombre de cellules filtrées en parcourant les plages de cellules composant groupe_plage_cellule
  
  for i=0 to ubound(groupe_plage_cellule.RangeAddresses)
     nb_cellule=nb_cellule+groupe_plage_cellule.RangeAddresses(i).EndRow-groupe_plage_cellule.RangeAddresses(i).StartRow+1
  next i
 
  'Copie du contenu des cellules non vides dans le tableau resultat

  if nb_cellule>0 then
    redim resultat(nb_cellule-1)                            'La dimension du tableau inclut les cellules vides
    for i=0 to ubound(groupe_plage_cellule.RangeAddresses)  'On parcourt les plages de cellules générées par le filtre
       plage_cellule_apres_filtre=groupe_plage_cellule(i)
       aux=plage_cellule_apres_filtre.DataArray             'DataArray renvoie un tableau de lignes contenant un tableau de cellules
       for j=0 to ubound(aux)                               'On parcourt les lignes de la plage de cellules
          if aux(j)(0)<>"" then                             'Comme on traite une seule colonne, il n'y a qu'une cellule par ligne
            resultat(k)=aux(j)(0)
            k=k+1
          end if
       next j
    next i
    if k<>nb_cellule then
      redim preserve resultat(k-1)                          'Le tableau est redimensionné pour éliminer les cellules vides
    end if   
  end if  
end sub
Date
Codé avec la version 6.0.6.2 (x64) de LibreOffice
function DimanchePaques(annee as integer) as date

  'Calcul de la date du dimanche de Pâques (formulaire de Delambre) 
  'Source : https://www.imcce.fr/newsletter/docs/lesdatesdepaques.pdf
  
  'En entrée 
    'annee : à partir de 1583 
  'En sortie
    'date du dimanche de Pâques
  
  dim a as integer,b as integer,c as integer,d as integer,e as integer
  dim f as integer,g as integer,h as integer,i as integer,k as integer
  dim l as integer,m as integer,n as integer,p as integer
  
  a=annee mod 19
  b=annee\100
  c=annee mod 100
  d=b\4
  e=b mod 4
  f=(b+8)\25
  g=(b-f+1)\3
  h=((19*a)+b-d-g+15) mod 30
  i=c\4
  k=c mod 4
  l=(32+(2*e)+(2*i)-h-k) mod 7
  m=(a+(11*h)+(22*l))\451
  n=(h+l-(7*m)+114) \ 31
  p=(h+l-(7*m)+114) mod 31
  DimanchePaques=dateserial(annee,n,p+1)
end function
Feuille
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub FeuilleCopier(document as object,feuille1 as integer,feuille2 as integer)

  'Copie le contenu entier d'une feuille dans une autre feuille existante du même classeur
  'La numérotation des feuilles débute à 0

  'document  : document contenant la feuille à copier
  'feuille1  : feuille contenant les cellules à copier
  'feuille2  : feuille dans laquelle sont recopiées les cellules

  dim adresse_source      as object
  dim adresse_destination as object
  dim feuille_source      as object
  dim feuille_destination as object
 
  feuille_source=document.Sheets(feuille1)
  adresse_source=feuille_source.rangeAddress                                  'Sélection de la feuille
  feuille_destination=document.Sheets(feuille2)
  adresse_destination=feuille_destination.getCellByPosition(0,0).cellAddress  'Sélection de la cellule pour la recopie 
  feuille_destination.copyRange(adresse_destination,adresse_source)           'Recopie du contenu de la feuille
end sub
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub FeuilleCreer(document as object,nom_feuille as string,position as integer,masquer as boolean,optional erreur as integer)

  'Crée une feuille dans un classeur.
  
  'En entrée
  '  document           : document contenant la feuille à créer
  '  nom_feuille        : nom de la feuille à créer
  '  position           : position de la feuille à créer (0 est la position la plus à gauche)
  '  masquer            : true=la feuille créée est masquée / false=la feuille est visible
  'En sortie
  '  erreur (optionnel) : variable optionnelle renvoyant 0 en cas de succès ou un code d'erreur
  
  on local error goto anomalie
  
  if position<0 then position=0
  document.sheets.insertNewByName(nom_feuille,position)
  if masquer then document.sheets(position).IsVisible=false
  if IsMissing(erreur)=false then erreur=0                               
  exit sub
  
  anomalie:
  if IsMissing(erreur)=false then erreur=Err
end sub
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub FeuilleDupliquer(document as object,source as string,destination as string,position as integer,masquer as boolean,optional erreur as integer)

  'Duplique une feuille dans le même classeur.
  
  'En entrée
  '  document           : document contenant la feuille à dupliquer
  '  source             : nom de la feuille à dupliquer.
  '  destination        : nom de la feuille dupliquée
  '  position           : position de la feuille dupliquée (0 est la position la plus à gauche)
  '  masquer            : true=la feuille dupliquée est masquée / false=feuille visible
  'En sortie
  '  erreur (optionnel) : variable optionnelle renvoyant 0 en cas de succès ou un code d'erreur
  
  on local error goto anomalie
  
  if position<0 then position=0
  document.sheets.copyByName(source,destination,position)
  if masquer then document.sheets(position).IsVisible=false
  if IsMissing(erreur)=false then erreur=0                               
  exit sub
  
  anomalie:
  if IsMissing(erreur)=false then erreur=Err
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub ReinitialiserFeuille(document as object,num_feuille as integer)

  'Réinitialise la feuille en la supprimant et en la recréant au même emplacement avec le même nom
  
  'document    : document contenant la feuille
  'num_feuille : index de la feuille à réinitialiser (l'index de la première feuille vaut 0)
  
  dim feuille     as object
  dim nom_feuille as string
  dim nb_feuille  as integer
  
  nb_feuille=document.sheets.count 
  if (num_feuille<0) or (num_feuille+1>nb_feuille) then exit sub 'Vérifie l'existence de la feuille
  feuille=document.sheets(num_feuille)
  if nb_feuille=1 then
    nom_feuille=feuille.name
    feuille.name=" "                                             'Renomme la feuille à supprimer pour pouvoir la recréer
    document.sheets.insertNewByName(nom_feuille,num_feuille+1)   'Insertion avant suppression car un classeur doit avoir au moins une feuille
    document.sheets.removeByName(" ")                            'Supprime la feuille renommée                   
  end if 
  if nb_feuille>1 then
    nom_feuille=feuille.name
    document.sheets.removeByName(nom_feuille)
    document.sheets.insertNewByName(nom_feuille,num_feuille)     'La nouvelle feuille a pour index num_feuille 
  end if  
end sub
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub FeuilleRenommer(document as object,nom_ancien as string,nom_nouveau as string,masquer as boolean,optional erreur as integer)

  'Renomme une feuille d'un classeur.
  
  'En entrée
  '  document           : document contenant la feuille à renommer
  '  nom_ancien         : nom de la feuille à renommer
  '  nom_nouveau        : nouveau nom de la feuille
  '  masquer            : true=la feuille renommée est masquée / false=la feuille est visible
  'En sortie
  '  erreur (optionnel) : variable optionnelle renvoyant 0 en cas de succès ou un code d'erreur
  
  dim feuille  as object
  dim position as integer
  
  on local error goto anomalie
  
  feuille=document.sheets.getByName(nom_ancien)
  feuille.name=nom_nouveau
  if masquer then feuille.IsVisible=false
  if IsMissing(erreur)=false then erreur=0                               
  exit sub
  
  anomalie:
  if IsMissing(erreur)=false then erreur=Err
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub RetrouverNumeroFeuille(document as object,nom_feuille as string,num_feuille as integer)

  'Recherche le numéro de la feuille dans le document à partir de son nom
  
  'document    : document contenant la feuille
  'nom_feuille : nom de la feuille
  'num_feuille : retourne le numéro de la feuille s'il y a une correspondance, -1 dans le cas contraire
  
  dim feuille as object
  
  num_feuille=-1
  if document.sheets.hasByName(nom_feuille) then
    feuille=document.sheets.getByName(nom_feuille)
    num_feuille=feuille.RangeAddress.Sheet
  end if  
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub SupprimerFeuille(document as object,num_feuille as integer)

  'Supprime la feuille du classeur
  
  'document    : document contenant la feuille
  'num_feuille : index de la feuille à supprimer (l'index de la première feuille vaut 0)
  
  dim feuille    as object
  dim nb_feuille as integer
  
  nb_feuille=document.sheets.count
  if nb_feuille=1 then exit sub                                  'Un classeur doit contenir au moins une feuille ! 
  if (num_feuille<0) or (num_feuille+1>nb_feuille) then exit sub 'Vérifie l'existence de la feuille
  feuille=document.sheets(num_feuille)
  document.sheets.removeByName(feuille.name)
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub SupprimerFeuilleSauf(document as object,nom_feuille as string)

  'Supprime toutes les feuilles du classeur sauf celle nommée nom_feuille
  
  'document    : document contenant la feuille
  'nom_feuille : Nom de la seule feuille du classeur qui ne sera pas supprimée. Sensible à la casse
  
  dim feuille    as object
  dim nb_feuille as integer
  dim i          as integer
  
  nb_feuille=document.sheets.count
  if nb_feuille=1 then exit sub                                        'Un classeur doit contenir au moins une feuille ! 
  for i=nb_feuille to 1 step -1
     feuille=document.sheets(i-1)                                      'l'index de la première feuille vaut 0 et non 1
     if (feuille.name<>nom_feuille) and (document.sheets.count>1) then 
       document.sheets.removeByName(feuille.name)
     end if
  next i
end sub
Fichier
Codé avec la version 6.0.6.2 (x64) de LibreOffice
function CheminDocument(document as object) as string

  'Retourne au format URL le chemin du fichier associé à document
  'Le chemin se termine par le caractère / (ex : file:///C:/Users/martin/Desktop/)
 
  dim aux as string
  dim car as string
  dim i   as integer

  aux=document.getlocation()
  i=len(aux)
  do
    car=Mid(aux,i,1)
    i=i-1
  loop until car="/" or i=0 
  if car="/" then CheminDocument=Mid(aux,1,i+1) else CheminDocument=""
end function
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub FichierDecouper(source as string,destination as string,nb as long,entete as boolean,optional erreur as integer)

  'Découpe un fichier texte en plusieurs fichiers de nb lignes
  'Le nom des fichiers créés est suffixé par un nombre incrémenté.
  'ATTENTION : les caractères de fin de lignes dans les fichiers créés dépendent de l'OS utilisé
  
  'Exemple : si source="c:\temp\test.txt et destination=c:\temps\resultat.txt
  '          alors génèration des fichiers c:\temp\resultat_00001.txt, c:\temp\resultat_00002.txt...
  
  'En entrée
    'source      : fichier à découper (chemin absolu impératif)
    'destination : fichier résultat (chemin absolu impératif). 
    'nb          : nombre de lignes par fichier créé.
    'entete      : true  => la première ligne du fichier source est recopiée dans chaque fichier créé.
  'En sortie  
    'erreur      : variable optionnelle renvoyant 0 en cas de succès ou un code d'erreur
                
  dim cheminfic  as string   'Chemin du fichier créé
  dim ligne      as string   'Contenu d'une ligne
  dim ligne1     as string   'Ligne en-tête
  dim extension  as string   'Extension du fichier créé
  dim nomfic     as string   'Nom du fichier créé sans son chemin ni son extension
  dim suffixe    as string   'Suffixe du nom du fichier créé
  dim chaine()   as string   
  dim compteur   as integer  'Compte le nombre de fichiers créés
  dim j          as integer
  dim NumeroFic1 as integer  'Fichier source
  dim NumeroFic2 as integer  'Fichier créé
  dim i          as long     'Compteur du nombre de lignes écrites

  if nb<1 then exit sub
  on local error goto ErreurLireFichier

  'Recherche du chemin, du nom et de l'extension du fichier de destination
  source=convertToUrl(source)
  destination=convertToUrl(destination)
  chaine=split(destination,"/")
  j=ubound(chaine)
  nomfic=chaine(j)
  cheminfic=mid(destination,1,len(destination)-len(nomfic))
  chaine=split(nomfic,".")
  j=ubound(chaine)
  if j>0 then
    extension="."+chaine(j)
    nomfic=mid(nomfic,1,len(nomfic)-len(extension))
  end if  
  
  'Génération des fichiers    
  NumeroFic1=freefile
  open source for input as #NumeroFic1
  if (entete) and (not eof(#NumeroFic1)) then line input #NumeroFic1,ligne1 
  While not eof(#NumeroFic1)
       NumeroFic2=freefile
       compteur=compteur+1
       suffixe="_"+format(compteur,"00000")
       open cheminfic+nomfic+suffixe+extension for output as #NumeroFic2
       if entete then
         i=i+1
         print #NumeroFic2,ligne1                                                  
       end if
       while (i<nb) and (not eof(#NumeroFic1))
            i=i+1
            line input #NumeroFic1,ligne
            print #NumeroFic2,ligne                                          
       wend
       close #NumeroFic2
       i=0
  wend
  close #NumeroFic1
  if IsMissing(erreur)=false then erreur=0  
  exit sub
  
  'Récupération du code erreur si la génération des fichiers a échoué
  ErreurLireFichier:
  if IsMissing(erreur)=false then erreur=Err
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
function NomFichierSansExtension(chemin_fichier as variant) as string

  'Retourne le nom du fichier sans son chemin ni son extension
  
  'En entrée, chemin_fichier peut être une chaîne de caractères ou une variable objet associée au fichier
 
  dim aux as string
  dim car as string
  dim nom as string
  dim i   as long
  dim j   as long
  dim nb  as long
  dim obj as object   

  nom=""
  if VarType(chemin_fichier)=9 then
    obj=chemin_fichier
    aux=obj.getlocation()
  else
    aux=convertToUrl(chemin_fichier)
  end if  
  nb=len(aux)
  if nb>0 then
    if Mid(aux,nb,1)="/" then nb=nb-1       'Si "/" est le dernier caractère
    i=nb
    j=nb
    do
      car=Mid(aux,i,1)
      i=i-1
      if (car=".") and (j=nb) then j=i      'Si extension détectée
    loop until (car="/") or (i=0) 
    if car="/" then nom=mid(aux,i+2,j-i-1)
  end if
  NomFichierSansExtension=nom  
end function
Filtre
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub AutofiltreCreer(document as object,num_feuille as integer,x1 as long,y1 as long,x2 as long,y2 as long,nom as string)
 
  'Crée un autofiltre
  
  'document    : document contenant l'autofiltre
  'num_feuille : numéro de la feuille contenant l'autofiltre
  '(x1,y1)     : coordonnées du coin supérieur gauche de la plage des en-têtes
  '(x2,y2)     : coordonnées du coin inférieur droit de la plage des en-têtes
  'nom         : nom de l'autofiltre (plusieurs autofiltres possibles mais avec des noms différents)
  
  dim feuille       as object
  dim libelle_champ as object
  dim plage_cellule as object
  
  if document.DatabaseRanges.hasByName(nom) then                              'L'autofiltre existe déjà ? Si oui...
    plage_cellule=document.DatabaseRanges.getByName(nom)                      '... Sélection de la base de données                 
    plage_cellule.Autofilter=false                                            '... Suppression de l'autofiltre
    document.DatabaseRanges.removeByName(nom)                                 '... Suppression de la base de données associée
  end if  
  feuille=document.sheets(num_feuille)
  libelle_champ=feuille.getCellRangeByPosition(x1,y1,x2,y2)                   'La plage des en-têtes est définie...
  document.DatabaseRanges.addNewByName(nom,libelle_champ.getRangeAddress())   '... puis elle est nommée.
  plage_cellule=document.DatabaseRanges.getByName(nom)                        'Création de la base de données...                 
  plage_cellule.Autofilter=true                                               '... puis activation de l'autofiltre.
end sub
Ligne
Codé avec la version 7.0.3.1 (x64) de LibreOffice
function DerniereLigneNonVide(document as object,num_feuille as integer) as long

  'Retourne le numéro de la dernière ligne de la feuille qui n'est pas vide ou -1 si la feuille est vide
  'La numérotation des feuilles, lignes et colonnes débutent à 0
  'ATTENTION : une cellule formatée, par exemple avec une bordure ou une couleur d'arrière-plan, est considérée comme non vide 

  'En entrée
    'document    : document contenant la feuille
    'num_feuille : index de la feuille  
  
  dim cellule as object
  dim curseur as object
  dim feuille as object
  dim colonne as long
  dim ligne   as long

  feuille=document.Sheets(num_feuille)
  curseur=feuille.createCursor                        'Création d'un curseur pour se déplacer dans l'objet feuille
  curseur.gotoEndOfUsedArea(false)
  ligne=curseur.RangeAddress.EndRow
  colonne=curseur.RangeAddress.EndColumn
  if ligne=0 and colonne=0 then                       'Possibilité que la feuille soit vide si ligne et colonne valent 0
    cellule=feuille.GetCellByPosition(colonne,ligne)
    if cellule.GetType()=EMPTY then ligne=-1         
  end if
  DerniereLigneNonVide=ligne
end function
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub InsererLigneApres(document as object,ByVal numfeuille as integer,ByVal numligne as long,ByVal nbligne as long)

  'Insère une à plusieurs lignes vides apres la ligne sélectionnée
  
  ' document   : document dans lequel on insère les lignes vides
  ' numfeuille : numéro de feuille du document dans lequel on insère les lignes vides (la numérotation débute à 0)
  ' numligne   : numéro de la ligne apres lequel on insère les lignes vides (la numérotation débute à 0)
  ' nbligne    : nombre de lignes vides à insérer
  
  dim ensembleLigne as object
  dim maxligne      as long
  
  numligne=numligne+1    
  ensembleLigne=document.Sheets(numfeuille).Rows
  maxligne=ensembleLigne.Count-1
  if numligne>=0 and nbligne>0 and numligne+nbligne<=maxligne then 
    ensembleLigne.insertByIndex(numligne,nbligne)
  end if  
end sub
Codé avec la version 6.0.6.2 (x64) de LibreOffice
sub InsererLigneAvant(document as object,ByVal numfeuille as integer,ByVal numligne as long,ByVal nbligne as long)

  'Insère une à plusieurs lignes vides avant la ligne sélectionnée
  
  ' document   : document dans lequel on insère les lignes vides
  ' numfeuille : numéro de feuille du document dans lequel on insère les lignes vides (la numérotation débute à 0)
  ' numligne   : numéro de la ligne avant lequel on insère les lignes vides (la numérotation débute à 0)
  ' nbligne    : nombre de lignes vides à insérer
  
  dim ensembleLigne as object
  dim maxligne      as long
      
  ensembleLigne=document.Sheets(numfeuille).Rows
  maxligne=ensembleLigne.Count-1
  if numligne>=0 and nbligne>0 and numligne+nbligne<=maxligne then 
    ensembleLigne.insertByIndex(numligne,nbligne)
  end if  
end sub
Tableau
Codé avec la version 7.0.3.1 (x64) de LibreOffice
Function TableauDim(tableau()) as variant

  'Retourne dans un tableau à 2 dimensions (dont les index débutent à 1) toutes les bornes inférieures  
  'et supérieures du tableau en entrée
  
  'Exemple : si tableau est dimensionné ainsi : (0 to 4,-1 to 1)
  '          alors TableauDim(1,1)=0, TableauDim(1,2)=4, TableauDim(2,1)=-1 et TableauDim(2,2)=1
 
  dim aux     as new collection
  dim i       as long
  dim j       as long
  dim k       as long  
  dim borne() as long               'Tableau à 2 dimensions 
  
  on local error goto fin_dimension 'Pas de fonction pour connaître le nombre de dimensions...
  
  while true                        '...alors sortie de la boucle lorsque lbound génère une erreur
    i=i+1
    aux.add(lbound(tableau,i))      'Borne inférieure d'une dimension du tableau en entrée
    aux.add(ubound(tableau,i))      'Borne supérieure d'une dimension du tableau en entrée
  wend

  fin_dimension:
  j=aux.count/2
  if j>0 then
    redim borne(1 to j,1 to 2)
    for i=1 to j 
       borne(i,1)=aux.item(k+1)
       borne(i,2)=aux.item(k+2)
       k=k+2 
    next i
  end if
  TableauDim()=borne()
end function
Codé avec la version 7.0.3.1 (x64) de LibreOffice
sub TriShellMetzner(tableau() as variant)

  'Trie le tableau en entrée par ordre croissant des données
  'La comparaison s'effectue entre deux éléments séparés par un écart égal à la moitié de la taille du tableau.
  
  dim ecart  as long
  dim i      as long
  dim j      as long
  dim k      as long
  dim m      as long
  dim n      as long   
  dim r      as long                   'Valeur pour un changement de repère à 1 comme indice minimal du tableau
  dim x      as variant          
  dim sortie as boolean

  n=ubound(tableau)-lbound(tableau)+1
  if n<2 then exit sub                 'Le tableau doit contenir au moins deux éléments pour être trié                    '
  r=1-lbound(tableau)
  ecart=n
  do
    ecart=ecart\2
    j=1
    k=n-ecart
    do
      i=j
      sortie=false
      do
        m=i+ecart
        if tableau(i-r)>tableau(m-r) then
          x=tableau(i-r)
          tableau(i-r)=tableau(m-r)
          tableau(m-r)=x
          i=i-ecart
        else
          sortie=true  
        end if
      loop until (i<1) or (sortie=true)
      j=j+1
    loop until j>k
  loop until ecart=1
end sub
Texte
Codé avec la version 6.0.6.2 (x64) de LibreOffice
function InsererTexte(source as string, ajout as string,byval position as integer) as string

  'Insère la sous-chaîne ajout dans la chaîne de caractères source avant la position indiquée 
  'Exemple : insererTexte(123456789,"moi",2) => 1moi23456789
  
  dim debut as string
  dim fin   as string
  
  if position<1 then position=1
  debut=mid(source,1,position-1)
  fin=mid(source,position)
  InsererTexte=debut+ajout+fin 
end function
Codé avec la version 6.0.6.2 (x64) de LibreOffice
function SepMillierEntier(nombre as string) as string

  'Ajoute un séparateur des milliers à un entier relatif stocké sous forme de texte
  'et supprime les 0 placés devant.
  'Pas de contrôle du nombre en entrée.
  
  const separateur=" "             
  
  dim signe as integer
  dim i as long,j as long,k as long,max as long
  dim aux as string,car as string
  
  i=1
  max=len(nombre)
  car=Mid(nombre,1,1)
  if car="-" then signe=1
  while (Mid(nombre,i+signe,1)="0") and (i+signe<max)  'Suppression des zéros placés devant le nombre
    i=i+1
  wend
  k=(max-(i+signe)+1) mod 3                            'Calcul de la position du premier séparateur
  if k=0 then k=3  
  for j=i+signe to max
     if k=0 then                                       'Ajout d'un séparateur des milliers 
       aux=aux+separateur
       k=2
     else
       k=k-1
     end if   
     car=Mid(nombre,j,1)
     aux=aux+car 
  next j
  if signe=1 then aux="-"+aux                          'Ajout du signe
  SepMillierEntier=aux
end function