Page 1 sur 1

[Calc]Fonction NBSTYLE()

Publié : 17 mars 2016 01:37
par zeguedon
Bonjour,

Fonction BNSTYLE() :
Destinée aux utilisateurs privilégiant l'utilisation de cellules uniquement colorées pour gérer les événements d'un planning, elle permet de comptabiliser celles dont un style particulier leurs est appliqué, pour une ligne, une colonne ou l'ensemble d'un tableau.
La fonction NBSTYLE() n'est pas implémentée nativement dans AOO/LO probablement parce que son utilisation ne rentre pas dans le cadre d'une exploitation conventionnelle d'un tableur. Il faut donc la considérer comme un contournement de la bonne pratique, qui devrait-être de comptabiliser exclusivement des valeurs alphabétiques ou numériques, colorées par formatage conditionnel lorsque la coloration s'impose pour améliorer la lisibilité du tableau.
Elle peut cependant devenir complémentaire d'une utilisation dite conventionnelle, permettant dans ce cas d'affecter plusieurs informations à une même cellule. L'une serait un texte ou une valeur numérique correspondant à un événement particulier, une autre par le biais du style appliqué à la cellule donnerait une information complémentaire pour cette même cellule, et une dernière par le biais du formatage conditionnel qui ne modifie pas le style de la cellule mais seulement son apparence. Mais là n'est pas le sujet du jour.

La plage peut être nommée ou définie par ses références.
La plage peut-être étendue par insertion de lignes, colonnes ou déplacée.
Lorsque la fonction utilise des références, elle peut être étirée.

La fonction utilise une formule nommée "Id" :

Code : Tout sélectionner

ADDRESS(ROW();COLUMN();4)&""|""&NOW() 

Elle permet :
  • 1) de récupérer l'objet cellule utilisant la fonction.
    2) de détecter un changement de style grâce à la fonction "NOW() qui s'actualise dès qu'une modification est apportée au classeur.
    La fonction est alors recalculée automatiquement lors d'un changement de style.
Syntaxe :

Code : Tout sélectionner

NBSTYLE(RéférencesPlage;NomDuStyle;Id)
La formule nommée "Id" doit-être initialisée dès la première utilisation en saisissant =NBSTYLE() (sans arguments) dans une cellule quelconque, puis effacé ensuite.
NBSTYLE.png

Code : Tout sélectionner

REM  *****  BASIC  *****


Option Explicit

Private oDoc As Object
Private feuilActive As Object

Function NBSTYLE(Optional Plage As Variant ,_
Optional Style As String ,Optional Tag As Variant)As Double
Dim celluleRef As Object ,lesZonesNom As Object
On Error Resume Next
oDoc = Thiscomponent
feuilActive = oDoc.CurrentController.ActiveSheet
celluleRef = feuilActive.GetCellRangeByName("A1")
lesZonesNom = oDoc.NamedRanges
If Not lesZonesNom.hasByName("Id") then
	lesZonesNom.addNewByName(_
	"Id", "ADDRESS(ROW();COLUMN();4)&""|""&NOW()", celluleRef.CellAddress ,0)
	NBSTYLE = 0
	exit Function	
End If
If IsMissing(Tag) Then
	MsgBox("Le troisième argument nommé : Id n'est pas facultatif" & Chr(10) &_
			" Syntaxe : NBSTYLE(RéférencesPlage;NomDuStyle;Id)")
	exit Function
End If
If Not IsArray(Plage) Then
	if oDoc.NamedRanges.hasByName(Plage) Then	 	
		plage = lesZonesNom.GetByName(Plage).GetReferredCells.RangeAddress
		NBSTYLE = Compter(plage ,Style)
	else
		print "Cette plage n'existe pas !" 	
	end if
End If
If IsArray(Plage) Then	
	Tag() = split(Tag ,"|")
	NBSTYLE = Compter(Renifleur(Tag(0)) ,Style)
End If
On Error GoTo 0
End Function
'---------------------------------------------------------------------------
REM :Compte pour "Plage" le nombre de cellules du "Style" passé en argument.
'--------------------------------------------------------------------------- 
Function Compter(Plage As object ,Style As String) As Double
Dim cellule As Object ,i As Long ,j As Long ,compteur As Double
For i = plage.StartRow To plage.EndRow
    For j = plage.StartColumn To plage.EndColumn   
        cellule = oDoc.Sheets(plage.Sheet).GetCellByPosition(j ,i)
        if cellule.CellStyle = Style Then
            compteur = compteur + 1
        End if
     next j   
Next i
Compter = compteur
End Function
'----------------------------------------------------------------------
REM :Décortique la formule à l'adresse Tag et retourne un RangeAddress. 
'----------------------------------------------------------------------
Function Renifleur(Tag) As Object
Dim plage As Object ,celluleRef As Object ,feuil As String
Dim ref() ,reff() ,refx() ,refy() ,refz()
celluleRef = feuilActive.GetCellRangeByName(Tag)
ref() = Join(Split(celluleRef.Formula, "$"), "")
refx() = split(ref() ,"(")
refy() = split(refx(1) ,";")
refz() = split(refy(0) ,".")
if Ubound(refz()) = 0 Then 'Nom de feuille absent !
	ref() = refz(0)
	feuil = feuilActive.Name
else
	ref() = refz(1)
	reff() = split(refz(0) ,"'")
	if Ubound(reff()) = 0 Then 'Le nom de feuille n'est pas numérique.
		feuil = reff(0)
	else
		feuil = reff(1)
	end if
end if
plage = oDoc.Sheets.GetByName(feuil).GetCellRangeByName(ref()).RangeAddress
Renifleur = plage 
End Function
'---------------------------------------------------------------------
'         Merci à la "Bible" ,Xray ,et au forum en général           -
'	 pour leur richesse d'informations pertinentes et constructives  - 
'	    sans quoi je n'aurais pas pu réaliser cette fonction	     -
'---------------------------------------------------------------------