Texte Définir les propriétés d'une cellule ou d'un Range (couleurs, fonte, ..., valeur) dans une formule

[Dudu2]

Ces fonctions personnalisées permettent de définir les propriétés d'une cellule ou d'une plage de cellules à partir d'une formule.

Version: 16-08-2024 (voir Post suivant)

Ces fonctions s'utilisent par concaténation (&) ou par somme (+) dans les formules selon le type souhaité de la valeur résultat. Dans les 2 cas, elles n'ont aucun effet sur le résultat.

Il y a 3 fonctions personnalisées:

1. CallerProperties
   C'est celle qui sera le plus souvent utilisée dans une formule pour définir les propriétés de la cellule qui contient la formule.
   
   Paramètres (tous optionnels):
   - Couleur de fonte (type Long)
   - Couleurs de fond (type Long)
   - Nom de la fonte (type String)
   - Taille de la fonte (type Integer / Single / Double)
   - Gras (type Boolean)
   - Italique (type Boolean)
   - Gras (type Boolean)
   - Souligné (type Variant, Énumération XlUnderlineStyle)
   - Barré (type Boolean)
   
   Exemple: = "Bonjour" & CallerProperties(HEXDEC("FF");HEXDEC("FFFF"))
   La cellule contenant la formule sera en caractères rouges ("FF") sur fond jaune ("FFFF").
   
   
   
   
   
   
2. RangeProperties
   Permet de définir les propriétés d'une plage de cellules quelconque désignée dans la formule.
   
   Paramètres (tous optionnels sauf le 1er):
   - Range concerné (type Range)
   - Couleur de fonte (type Long)
   - Couleurs de fond (type Long)
   - Nom de la fonte (type String)
   - Taille de la fonte (type Integer / Single / Double)
   - Gras (type Boolean)
   - Italique (type Boolean)
   - Gras (type Boolean)
   - Souligné (type Variant, Énumération XlUnderlineStyle)
   - Barré (type Boolean)
   
   Exemple en A3: = "Couleurs en B3:C3" & RangeProperties(B3:C3;HEXDEC("FF");HEXDEC("FFFF"))
   Les cellules B3:C3 seront en caractères rouges ("FF") sur fond jaune ("FFFF").
   
   
   
   
   
   
3. CellValue
   Permet de définir la valeur d'une cellule quelconque qui n'est pas la cellule qui contient la formule sous peine d'écraser la formule par la valeur indiquée.
   
   Paramètres:
   - Cellule concerné (type Range)
   - Valeur (type Variant, peut être une formule)
   
   Exemple en A2: = "Valeur en B2" & CellValue(B2;"Bonjour")
   La cellule B2 contiendra la valeur "Bonjour".
   
   
   
   
   
   Exemple en A2: = "Valeur en B2" & CellValue(B2;"=C2 + D2")
   Le cellule B2 contiendra la valeur 15.
   
   
   
   
   
   A noter que CellValue et RangeProperties peuvent être utilisées dans la même formule.
   
   Exemple en A4: = "Valeurs & couleurs en B4:C4" & CellValue(B4;"Bonjour") & CellValue(C4;"à tous") & RangeProperties(B4:C4;HEXDEC("FF");HEXDEC("FFFF00"))
   
   
   

Option Explicit

'------------------
'Version 16/08/2024
'------------------

#If VBA7 Then
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" (ByVal hWnd As LongPtr, ByVal nIDEvent As Long) As Long
#Else
    Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
#End If
'
Private SetPropertiesCollection As New Collection
Private TimerId As Long
'
'-----------------------------------------------------------------------------------------------------------------------------------------------
'Quand la fonction CellValue() affecte une valeur dans la cellule indiquée, la formule qui la contient sera automatiquement ré-évaluée par Excel
'si Application.Calculation <> xlCalculationManual car la cellule modifiée fait partie des arguments de la fonction CellValue().
'Ce flag permet d'inhiber les traitements issus de cette ré-évaluation automatique qui a lieu immédiatement après l'affectation de la valeur.
'-----------------------------------------------------------------------------------------------------------------------------------------------
Private ExcelCalculation As Boolean

'------------------------------------------------------------------------
'Propriétés de la cellule dont la formule concatène ou ajoute la fonction
'Exemple: = "Bonjour" & CallerProperties(HEXDEC("FF");HEXDEC("FFFF")) -> texte en rouge sur fond jaune sur la cellule "Caller"
'https://learn.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/color-constants
'------------------------------------------------------------------------
Function CallerProperties(Optional ByVal FontColor As Long = xlNone, _
                          Optional ByVal InteriorColor As Long = xlNone, _
                          Optional ByVal FontName As Variant = xlNone, _
                          Optional ByVal FontSize As Double = xlNone, _
                          Optional ByVal FontBold As Variant = xlNone, _
                          Optional ByVal FontItalic As Variant = xlNone, _
                          Optional ByVal FontUnderline As Variant = xlNone, _
                          Optional ByVal FontStrikethrough As Variant = xlNone)
 
    RangeProperties Application.Caller, FontColor, InteriorColor, FontName, FontSize, FontBold, FontItalic, FontUnderline, FontStrikethrough
End Function
                
'----------------------------------------------------------------------------------
'Propriétés d'une plage quelconque dont une formule concatène ou ajoute la fonction
'Exemple en A3: = "Couleurs en B3" & RangeProperties(B3;HEXDEC("FF");HEXDEC("FFFF")) -> couleurs texte en rouge sur fond jaune en B3
'https://learn.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/color-constants
'----------------------------------------------------------------------------------
Function RangeProperties(ByVal Target As Range, _
                         Optional ByVal FontColor As Long = xlNone, _
                         Optional ByVal InteriorColor As Long = xlNone, _
                         Optional ByVal FontName As Variant = xlNone, _
                         Optional ByVal FontSize As Double = xlNone, _
                         Optional ByVal FontBold As Variant = xlNone, _
                         Optional ByVal FontItalic As Variant = xlNone, _
                         Optional ByVal FontUnderline As Variant = xlNone, _
                         Optional ByVal FontStrikethrough As Variant = xlNone)
                     
    Dim TabProperties(1 To 9) As Variant

    'Ré-évaluation automatique de la formule par Excel
    If ExcelCalculation Then Exit Function
 
    'Store the Properties into a Table
    Set TabProperties(1) = Target
    TabProperties(2) = FontColor
    TabProperties(3) = InteriorColor
    TabProperties(4) = FontName
    TabProperties(5) = FontSize
    TabProperties(6) = FontBold
    TabProperties(7) = FontItalic
    TabProperties(8) = FontUnderline
    TabProperties(9) = FontStrikethrough
 
    'Store the Table into a SetPropertiesCollection
    SetPropertiesCollection.Add TabProperties
     
    'Async run of the setting of the Properties
    If TimerId = 0 Then
        TimerId = SetTimer(0, 0, 100, AddressOf SetTargetProperties)
    End If
End Function

'--------------------------------------------------------------------------------
'Valeur d'une cellule quelconque dont une formule concatène ou ajoute la fonction
'Exemple en A2: = "Valeur en B2" & CellValue(B2;"Bonjour") -> Valeur "Bonjour" en B2
'--------------------------------------------------------------------------------
Function CellValue(ByVal Target As Range, _
                   ByVal Value As Variant)
                    
    Dim TabProperties(1 To 2) As Variant
 
    'Ré-évaluation automatique de la formule par Excel
    If ExcelCalculation Then Exit Function
 
    'Store the Value into a Table
    Set TabProperties(1) = Target
    TabProperties(2) = Value
 
    'Store the Table into a Collection
    SetPropertiesCollection.Add TabProperties
 
    'Async run of the setting of the Properties
    If TimerId = 0 Then
        TimerId = SetTimer(0, 0, 100, AddressOf SetTargetProperties)
    End If
End Function

'------------------------------------------------------------
'Fonction d'exécution des actions empilées dans la Collection
'------------------------------------------------------------
Private Sub SetTargetProperties()
    Dim TabProperties() As Variant
 
    KillTimer 0, TimerId
 
    Do While Not Application.Ready
        DoEvents
    Loop
 
    Do While SetPropertiesCollection.Count > 0
        TabProperties = SetPropertiesCollection(1)
     
        With TabProperties(1)
            'Set the Cell Value
            If UBound(TabProperties) = 2 Then
                'Inhibe l'appel des fonctions issu de la ré-évaluation automatique par Excel lors de la modification de la valeur
                ExcelCalculation = True
             
                'The Cell might not exist anymore if deleted
                On Error Resume Next
                .Value = TabProperties(2)
                On Error GoTo 0
             
                ExcelCalculation = False
             
            'Set the Range Properties
            Else
                If Not TabProperties(2) = xlNone Then .Font.Color = TabProperties(2)
                If Not TabProperties(3) = xlNone Then .Interior.Color = TabProperties(3)
                If Not TabProperties(4) = xlNone Then .Font.Name = TabProperties(4)
                If Not TabProperties(5) = xlNone Then .Font.Size = TabProperties(5)
                If Not TabProperties(6) = xlNone Then .Font.Bold = TabProperties(6)
                If Not TabProperties(7) = xlNone Then .Font.Italic = TabProperties(7)
                If Not TabProperties(8) = xlNone Then .Font.Underline = TabProperties(8)
                If Not TabProperties(9) = xlNone Then .Font.Strikethrough = TabProperties(9)
            End If
        End With
     
        SetPropertiesCollection.Remove (1)
    Loop
 
    TimerId = 0
End Sub

Le fichier joint contient les modules correspondants et des exemples.

 

[Dudu2]

La modification du 16/08/2024 s'applique à l'utilisation de la fonction personnalisée CellValue.

En effet, si l'on définit une formule avec par exemple =CellValue(C5;"Bonjour"), la valeur "Bonjour" sera placé en C5 par CellValue. Mais comme Excel ré-évalue automatiquement les fonctions personnalisées lorsqu'une cellule citée parmi ses arguments a été modifiée, cela provoquait une 2ème exécution de CellValue(C5;"Bonjour") et ainsi de suite. Cela ne bouclait pas mais stockait la 2ème modification dans la Collection des actions à réaliser. La modification fixe ce problème.