Cela fait un moment que je n'étais passé sur le forum mais j'en profite pour mettre à disposition des fonctions "génériques" que j'utilise dans l'outil que j'ai crée pour gérer les compétences du socle commun.
Vous trouverez donc des fonctions pour la gestions des cellules :
- cellules : pour formater une cellule ou des zones, pour écrire ou lire une cellule, trier, copier, déplacer ...
Si ces fonctions peuvent etre utiles pour certains j'en serai ravi.
Code : Tout sélectionner
REM ***** BASIC *****
Option explicit
'-----------------------------------------------------------------------------------------------
'Fonctions pour la gestion des cellules
'-----------------------------------------------------------------------------------------------
'Macro qui enregistre dans une cellule la valeur chaine dans la feuille donnée
'-----------------------------------------------------------------------------------------------
Sub EnrCell(feuille as String, Chaine as String, col as Integer, lig as Integer, Optional doc as Object)
Dim Sheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
if not VerifFeuille(feuille,oDoc) then
Exit Sub
end if
Sheet=RetourneFeuille(feuille,oDoc)
Sheet.getCellByPosition(col,lig).String=Chaine
end Sub
'-----------------------------------------------------------------------------------------------
'Enregistre une valeur dans une cellule
'-----------------------------------------------------------------------------------------------
Sub EnrCellValue(feuille as String, Chaine as Double, col as Integer, lig as Integer, Optional doc as Object)
Dim Sheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
if not VerifFeuille(feuille,oDoc) then
Exit Sub
end if
Sheet=RetourneFeuille(feuille,oDoc)
Sheet.getCellByPosition(col,lig).Value=Chaine
end Sub
'-----------------------------------------------------------------------------------------------
'Enregistre une formule dans une cellule
'-----------------------------------------------------------------------------------------------
Sub EnrCellFormula(feuille as String, formula as String, col as integer, lig as Integer, Optional doc as Object)
Dim Sheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
if not VerifFeuille(feuille,oDoc) then
Exit Sub
end if
Sheet=RetourneFeuille(feuille,oDoc)
Sheet.getCellByPosition(col,lig).Formula="="& formula
end Sub
'-----------------------------------------------------------------------------------------------
'Enregistre une formule sans sign"="
'-----------------------------------------------------------------------------------------------
Sub EnrCellFormulaDate(feuille as String, formula as String, col as integer, lig as Integer, Optional doc as Object)
Dim Sheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
if not VerifFeuille(feuille,oDoc) then
Exit Sub
end if
Sheet=RetourneFeuille(feuille,oDoc)
Sheet.getCellByPosition(col,lig).FormulaLocal=formula
end Sub
'-----------------------------------------------------------------------------------------------
'macro qui renvoie le string d'une cellule
'-----------------------------------------------------------------------------------------------
Sub CellString(feuille as string, col as Integer, lig as Integer, Optional doc as Object) as String
Dim Sheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
if not VerifFeuille(feuille,oDoc) then
Exit Sub
end if
Sheet=RetourneFeuille(feuille,oDoc)
CellString=Sheet.getCellByPosition(col,lig).String
end Sub
'-----------------------------------------------------------------------------------------------
'macro qui renvoie le value d'une cellule
'-----------------------------------------------------------------------------------------------
Sub CellValue(feuille as string, col as Integer, lig as Integer, Optional doc as Object) as double
Dim Sheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
if not VerifFeuille(feuille,oDoc) then
Exit Sub
end if
Sheet=RetourneFeuille(feuille,oDoc)
CellValue=Sheet.getCellByPosition(col,lig).Value
end Sub
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
'Macros pour gérer la mise forme d'une cellule
'-----------------------------------------------------------------------------------------------
Sub HCenter(feuille as String, c As Integer, l as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).HORIJUSTIFY=com.sun.star.table.CellHoriJustify.CENTER
end Sub
'-----------------------------------------------------------------------------------------------
Sub VCenter(feuille as String, c As Integer, l as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).VERTJUSTIFY=com.sun.star.table.CellVertJustify.CENTER
end Sub
'-----------------------------------------------------------------------------------------------
Sub Gras(feuille as String, c As Integer, l as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).CharWeight=com.sun.star.awt.FontWeight.BOLD
end Sub
'-----------------------------------------------------------------------------------------------
Sub Wrapped(feuille as String, c As Integer, l as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).IsTextWrapped=true
end Sub
'-----------------------------------------------------------------------------------------------
Sub BottomTop(feuille as String, c As Integer, l as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).Orientation=com.sun.star.table.CellOrientation.BOTTOMTOP
end Sub
'-----------------------------------------------------------------------------------------------
Sub BackColor(feuille as String, c As Integer, l as Integer, R as Integer, G as Integer, B as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).CellBackColor=RGB(R,G,B)
end Sub
'-----------------------------------------------------------------------------------------------
Sub CharColor(feuille as String, c As Integer, l as Integer, R as Integer, G as Integer, B as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).CharColor=RGB(R,G,B)
end Sub
'-----------------------------------------------------------------------------------------------
Sub CharHeight(feuille as String, c As Integer, l as Integer, taille as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).Charheight=taille
end Sub
'-----------------------------------------------------------------------------------------------
Sub MargesInternes(feuille as String, c as integer, l as Integer, retrait as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellByPosition(c,l).ParaIndent=retrait
end Sub
'-----------------------------------------------------------------------------------------------
Sub LargOptimale(feuille as String, col as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).Columns(col).OptimalWidth=true
end sub
'-----------------------------------------------------------------------------------------------
Sub HautOptimale(feuille as String, lig as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).Rows(lig).OptimalHeight=true
end sub
'-----------------------------------------------------------------------------------------------
Sub LigneHeight(feuille as String, lig as Integer, hauteur as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).Rows(lig).Height=hauteur
end sub
'-----------------------------------------------------------------------------------------------
Sub ColWidth(feuille as String, col as Integer, larg as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).Columns(col).Width=larg
end sub
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
'Macros pour gérer la mise forme d'une zone de cellules
'-----------------------------------------------------------------------------------------------
Sub ZoneHautOptimale(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object)
Dim oDoc as Object, oSheet as object, lignes as object, zone as object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
lignes=zone.Rows
lignes.OptimalHeight=true
end sub
'-----------------------------------------------------------------------------------------------
Sub ZoneLargOptimale(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object)
Dim oDoc as Object, oSheet as object, lignes as object, zone as object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
lignes=zone.Columns
lignes.OptimalWidth=true
end sub
'-----------------------------------------------------------------------------------------------
Sub BorduresZone(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object)
Dim zone as Object, oSheet as Object, bords as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
bords=zone.TableBorder
Dim unBord as New com.sun.star.table.BorderLine
With unBord
.OuterLineWidth=30
.Color=RGB(0,0,0)
bords.RightLine=unBord
bords.LeftLine=unBord
bords.TopLine=unBord
bords.BottomLine=unBord
bords.VerticalLine=unBord
bords.HorizontalLine=unBord
end with
With Bords
.IsBottomLineValid=true
.IsTopLineValid=true
.IsLeftLineValid=true
.IsRightLineValid=true
.IsHorizontalLineValid=true
.IsVerticalLineValid=true
end with
zone.TableBorder=bords
end sub
'-----------------------------------------------------------------------------------------------
Sub ZoneBackColor(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, R as Integer, G as Integer, B as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).CellBackColor=RGB(R,G,B)
end Sub
'-----------------------------------------------------------------------------------------------
Sub ZoneCharHeight(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, taille as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).CharHeight=taille
end Sub
'-----------------------------------------------------------------------------------------------
Sub ZoneCharColor(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, R as Integer, G as Integer, B as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).CharColor=RGB(R,G,B)
end Sub
'-----------------------------------------------------------------------------------------------
Sub ZoneHCenter(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).HORIJUSTIFY=com.sun.star.table.CellHoriJustify.CENTER
end Sub
'-----------------------------------------------------------------------------------------------
Sub ZoneVCenter(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).VERTJUSTIFY=com.sun.star.table.CellVertJustify.CENTER
end Sub
'-----------------------------------------------------------------------------------------------
Sub ZoneWrapped(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).IsTextWrapped=true
end Sub
'-----------------------------------------------------------------------------------------------
Sub ZoneBottomTop(feuille as String, colI As Integer, ligI as Integer, colF As Integer, ligF as Integer, Optional doc as Object)
Dim oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
RetourneFeuille(feuille,oDoc).getCellRangeByPosition(colI,ligI,colF,ligF).Orientation=com.sun.star.table.CellOrientation.BOTTOMTOP
end Sub
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------
'Fonctions sur la gestion des zones
'-----------------------------------------------------------------------------------------------
'Retourne l'index de ligne de fin d'une zone
'-----------------------------------------------------------------------------------------------
Function IndexFinZone(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object) as Integer
Dim Index as Integer, Sheet as Object, zone as Object, ZonesVides as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
Sheet=RetourneFeuille(feuille,oDoc)
zone=Sheet.getCellRangeByPosition(colI,ligI,colF,ligF)
ZonesVides=zone.queryEmptyCells.RangeAddresses
if UBound(ZonesVides) >= 0 then
index=ZonesVides(0).StartRow
end if
IndexFinZone=index-1
end Function
'-----------------------------------------------------------------------------------------------
'fusionne une zone de cellules
'-----------------------------------------------------------------------------------------------
Sub Fusionne(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer,Optional doc as Object)
Dim Sheet as Object, zone as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
Sheet=RetourneFeuille(feuille,oDoc)
zone=Sheet.getCellRangeByPosition(colI,ligI,colF,ligF)
zone.merge(true)
end Sub
'-----------------------------------------------------------------------------------------------
'Fonction qui convertit une zone de cellules en tableau
'-----------------------------------------------------------------------------------------------
Function ZoneVersTab(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object) as Variant
Dim oSheet as Object, zone as Object, tab as Variant, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
ZoneVersTab=zone.DataArray
end Function
'-----------------------------------------------------------------------------------------------
'Ecrit les valeurs d'un array dans une zone
'-----------------------------------------------------------------------------------------------
Sub TabVersZone(feuille as String, tab as Variant, colI as integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object)
Dim oSheet as Object, zone as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
zone.DataArray=tab
end Sub
'-----------------------------------------------------------------------------------------------
'Ecrit les valeurs d'un array avec des formules dans une zone
'-----------------------------------------------------------------------------------------------
Sub TabFormulesVersZone(feuille as String, tab as Variant, colI as integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object)
Dim oSheet as Object, zone as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
zone.FormulaArray=tab
end Sub
'-----------------------------------------------------------------------------------------------
'Macro qui filtre une zone suivant le critère donné (on recopie dans le meme doc)
'-----------------------------------------------------------------------------------------------
Sub FiltrerZone(feuilleini as String, zone as String, crit as Variant, col as integer, feuille as String, cellule as String, num as boolean, Optional doc as Object)
'zone doit etre donné sous la forme a1:b2, col correspond au numero de colonne à filtrer dans la zone
Dim monDocument As Object, lesFeuilles As Object
Dim maFeuille As Object, maZone As Object, index as Integer
Dim monFiltre As Object, feuilleResu As Object, pointResu As Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
Dim champsFiltre(0) As New com.sun.star.sheet.TableFilterField
if num=true then
With champsFiltre(0)
.Field = col
.Operator = com.sun.star.sheet.FilterOperator.EQUAL
.IsNumeric = true
.NumericValue = crit
End With
else
With champsFiltre(0)
.Field = col
.Operator = com.sun.star.sheet.FilterOperator.EQUAL
.IsNumeric = False
.StringValue = crit
End With
end if
maFeuille = RetourneFeuille(feuilleini, oDoc)
maZone = maFeuille.getCellRangeByName(zone)
monFiltre = maZone.createFilterDescriptor(True)
With monFiltre
.CopyOutputData = True
.ContainsHeader = False
.Orientation = com.sun.star.table.TableOrientation.COLUMNS
feuilleResu = RetourneFeuille(feuille,oDoc)
.OutputPosition = feuilleResu.getCellRangeByName(cellule).CellAddress
.FilterFields = champsFiltre()
End With
maZone.filter(monFiltre)
End Sub
'-----------------------------------------------------------------------------------------------
'copie une zone de cellule dans la feuille farriv à partir de la cellule en col et lig (meme doc)
'-----------------------------------------------------------------------------------------------
Sub CopierZone(zone as Object, farriv as String, col as Integer, lig as Integer, Optional doc as Object )
Dim cell as Object, SheetArriv as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
SheetArriv=RetourneFeuille(farriv,oDoc)
cell=SheetArriv.getCellByPosition(col,lig)
SheetArriv.copyRange(cell.CellAddress,zone.RangeAddress)
end Sub
'-----------------------------------------------------------------------------------------------
'Retourne le nom d'une colonne d'index donné
'-----------------------------------------------------------------------------------------------
Function NomColonne(X as Long) as String
Dim uneCellule as Object
uneCellule=ThisComponent.Sheets(0).getCellByPosition(X,0)
NomColonne=uneCellule.Columns.ElementNames(0)
end Function
'-----------------------------------------------------------------------------------------------
'Retourne l'index d'une colonne de nom donné
'-----------------------------------------------------------------------------------------------
Function IndexColonne(nom as String) as Long
Dim uneCellule as Object
uneCellule=ThisComponent.Sheets(0).getCellRangeByName(nom &"1")
IndexColonne=uneCellule.RangeAddress.StartColumn
end Function
'-----------------------------------------------------------------------------------------------
'Efface tous les elements d'une zone
'-----------------------------------------------------------------------------------------------
Sub EffaceZone(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, Optional doc as Object)
Dim zone as Object, oSheet as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
zone.clearContents(com.sun.star.sheet.CellFlags.VALUE +_
com.sun.star.sheet.CellFlags.DATETIME +com.sun.star.sheet.CellFlags.STRING +_
com.sun.star.sheet.CellFlags.HARDATTR +com.sun.star.sheet.CellFlags.FORMULA)
end sub
'-----------------------------------------------------------------------------------------------
'Déplace tous les elements d'une zone
'-----------------------------------------------------------------------------------------------
Sub DeplaceZone(feuille as String, farriv as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, col as Integer, lig as Integer, Optional doc as Object)
Dim oSheet as Object, zone as Object, oSheetArriv as Object, cArriv as Object, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
oSheet=RetourneFeuille(feuille,oDoc)
oSheetArriv=RetourneFeuille(farriv,oDoc)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
cArriv=oSheetArriv.getCellByPosition(col,lig)
oSheetArriv.moveRange(cArriv.CellAddress,zone.RangeAddress)
end sub
'-----------------------------------------------------------------------------------------------
'Macro pour le tri d'une zone sur une colonne
'-----------------------------------------------------------------------------------------------
Sub Trier1Colonne(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, col as Integer,Optional tri as boolean, Optional doc as Object)
Dim maFeuille As Object, maZone As Object, typetri as boolean
Dim ConfigTri(0) As New com.sun.star.table.TableSortField
Dim DescrTri As Variant, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
If IsMissing(tri) then
typetri=true
else
typetri=tri
end if
maFeuille = RetourneFeuille(feuille,oDoc)
maZone=maFeuille.getCellRangeByPosition(colI,ligI,colF,ligF)
With ConfigTri(0)
.Field = col ' le numero de colonne
.IsAscending = typetri
End With
DescrTri = maZone.createSortDescriptor
setPropVal(DescrTri, "SortFields", ConfigTri())
setPropVal(DescrTri, "IsSortColumns", false)
setPropVal(DescrTri, "CopyOutputData", false)
setPropVal(DescrTri, "IsUserListEnabled", false)
setPropVal(DescrTri, "BindFormatsToContent", false)
setPropVal(DescrTri, "ContainsHeader", false)
maZone.Sort(DescrTri())
End Sub
'-----------------------------------------------------------------------------------------------
'Supprime les lignes : le nb de lignes nb à partir de la ligne rang
'-----------------------------------------------------------------------------------------------
Sub SupprLignes(feuille as string,colI as Integer, ligI as Integer, colF as Integer, ligF as Integer,rang as integer, nb as integer)
Dim lignes as object, zone as object, oSheet as object
oSheet=RetourneFeuille(feuille)
zone=oSheet.getCellRangeByPosition(colI,ligI,colF,ligF)
lignes=zone.Rows
lignes.removeByIndex(rang,nb)
end sub
'-----------------------------------------------------------------------------------------------
'Macro pour le tri d'une zone sur deux colonne
'zone est sous la forme "A1:B5"
'-----------------------------------------------------------------------------------------------
Sub Trier2Colonne(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, col1 as Integer,col2 as Integer,Optional doc as Object)
Dim maFeuille As Object, maZone As Object
Dim ConfigTri(1) As New com.sun.star.table.TableSortField
Dim DescrTri As Variant, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
maFeuille = RetourneFeuille(feuille,oDoc)
maZone=maFeuille.getCellRangeByPosition(colI,ligI,colF,ligF)
ConfigTri(0).Field = col1 ' le numero de colonne
ConfigTri(0).IsAscending = true
ConfigTri(1).Field = col2 ' le numero de colonne
ConfigTri(1).IsAscending = true
DescrTri = maZone.createSortDescriptor
setPropVal(DescrTri, "SortFields", ConfigTri())
setPropVal(DescrTri, "IsSortColumns", false)
setPropVal(DescrTri, "CopyOutputData", false)
setPropVal(DescrTri, "IsUserListEnabled", false)
setPropVal(DescrTri, "BindFormatsToContent", false)
setPropVal(DescrTri, "ContainsHeader", false)
maZone.Sort(DescrTri())
End Sub
'-----------------------------------------------------------------------------------------------
'Macro pour le tri d'une zone sur trois colonnes
'zone est sous la forme "A1:B5"
'-----------------------------------------------------------------------------------------------
Sub Trier3Colonne(feuille as String, colI as Integer, ligI as Integer, colF as Integer, ligF as Integer, col1 as Integer,col2 as Integer,col2 as Integer, Optional doc as Object)
Dim maFeuille As Object, maZone As Object
Dim ConfigTri(2) As New com.sun.star.table.TableSortField
Dim DescrTri As Variant, oDoc as Object
If IsMissing(doc) then
oDoc=ThisComponent
else
oDoc=doc
end if
maFeuille = RetourneFeuille(feuille,oDoc)
maZone=maFeuille.getCellRangeByPosition(colI,ligI,colF,ligF)
ConfigTri(0).Field = col1 ' le numero de colonne
ConfigTri(0).IsAscending = true
ConfigTri(1).Field = col2 ' le numero de colonne
ConfigTri(1).IsAscending = true
ConfigTri(2).Field = col3 ' le numero de colonne
ConfigTri(2).IsAscending = true
DescrTri = maZone.createSortDescriptor
setPropVal(DescrTri, "SortFields", ConfigTri())
setPropVal(DescrTri, "IsSortColumns", false)
setPropVal(DescrTri, "CopyOutputData", false)
setPropVal(DescrTri, "IsUserListEnabled", false)
setPropVal(DescrTri, "BindFormatsToContent", false)
setPropVal(DescrTri, "ContainsHeader", false)
maZone.Sort(DescrTri())
End Sub
