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: 07-11-2024 (Ajout de la possibilité de valoriser Interior.Pattern à xlNone pour revenir à la valeur par défaut (utile en particulier dans les Tableaux Structurés)
Version: 30-09-2024 (Ajout de la fonction personnalisée RangeValues())
Version: 16-08-2024 (Fonction CellValue(): empêche la ré-évaluation automatique par Excel)

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.

Inconvénient:

Puisque les propriétés sont définies en VBA dans les fonctions personnalisées, lors de l'exécution d'une de ces fonctions, on perd la pile des défaire/refaire (l'Undo Stack).​

Il y a 4 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 passée sous forme de chaîne de caractères)
   
   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")
   La cellule B2 contiendra la valeur C2 + D2 soit 15.
   
   
   
   
   
   A noter que CellValue et RangeProperties peuvent être utilisées dans la même formule.
   
   Exemple en A3: = "Valeur et couleurs en B3" & CellValue(B3;"=C3 + D3") & RangeProperties(B3;HEXDEC("FF");HEXDEC("FFFF00"))
   La cellule A3 contiendra la valeur C3 + D3 soit 15 et sera en caractères rouges ("FF") sur fond bleu ("FFFF00").
   
   
   
   
   
   
4. RangeValues
   Permet de définir les valeurs d'une plage de cellules quelconque qui ne contient pas la cellule qui contient la formule sous peine d'écraser la formule par la valeur indiquée.
   
   Paramètres:
   - Range concerné (type Range)
   - Valeurs (type Variant, séparées par le séparateur de liste standard (";" (Fr) ou "," (En)), peut contenir des formules passées sous forme de chaînes de caractères)
   
   Exemple en A7: = "Valeurs en B7:C7" & RangeValues(B7:C7;"Bonjour";"=C9")
   La cellule B7 contiendra la valeur "Bonjour" et la cellule C7 contiendra C9 soit "à tous"
   
   
   
   
   
   A noter que RangeValues et RangeProperties peuvent être utilisées dans la même formule.
   
   Exemple en A5: = "Valeurs & couleurs en B5:C5" & RangeValues(B5:C5;"Bonjour";"à tous") & RangeProperties(B5:C5;HEXDEC("FF");HEXDEC("FFFF00"))
   La cellule B5 contiendra la valeur "Bonjour", la cellule C5 contiendra "à tous" et les 2 cellules seront en caractères rouges ("FF") sur fond bleu ("FFFF00").
   
   
   
   
   
   

   Option Explicit
   '------------------
   'Version 07/11/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
   Private Const NoValue = xlNone
   '
   '-----------------------------------------------------------------------------------------------------------------------------------------------
   '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
   '
   'Si InteriorColor = -1 alors la paterne de la cellule est mise à xlNone (valeur par défaut)
   '------------------------------------------------------------------------
   Function CallerProperties(Optional ByVal FontColor As Long = NoValue, _
                             Optional ByVal InteriorColor As Long = NoValue, _
                             Optional ByVal FontName As Variant = NoValue, _
                             Optional ByVal FontSize As Double = NoValue, _
                             Optional ByVal FontBold As Variant = NoValue, _
                             Optional ByVal FontItalic As Variant = NoValue, _
                             Optional ByVal FontUnderline As Variant = NoValue, _
                             Optional ByVal FontStrikethrough As Variant = NoValue)
    
       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
   '
   'Si InteriorColor = -1 alors la paterne du Range est mise à xlNone  (valeur par défaut)
   '----------------------------------------------------------------------------------
   Function RangeProperties(ByVal Target As Range, _
                            Optional ByVal FontColor As Long = NoValue, _
                            Optional ByVal InteriorColor As Long = NoValue, _
                            Optional ByVal FontName As Variant = NoValue, _
                            Optional ByVal FontSize As Double = NoValue, _
                            Optional ByVal FontBold As Variant = NoValue, _
                            Optional ByVal FontItalic As Variant = NoValue, _
                            Optional ByVal FontUnderline As Variant = NoValue, _
                            Optional ByVal FontStrikethrough As Variant = NoValue)
                        
       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
   'La valeur peut contenir une formule passée sous forme de chaînes de caractères
   '--------------------------------------------------------------------------------
   Function CellValue(ByVal Target As Range, _
                      ByVal Value As Variant)
                       
       RangeValues Target, Value
   End Function
   
   '-------------------------------------------------------------------------------------------
   'Valeurs d'une plage de cellules quelconque dont une formule concatène ou ajoute la fonction
   'Les valeurs sont séparées par le séparateur de liste standard (";" (Fr) ou "," (En))
   'Les valeurs peuvent contenir des formules passées sous forme de chaînes de caractères
   'Exemple en A2: = "Valeur en B2:C2" & RangeValues(B2:C2;"Bonjour";"à tous") -> Valeur "Bonjour" en B2 et "à tous" en C2
   '-------------------------------------------------------------------------------------------
   Function RangeValues(ByVal Target As Range, _
                        ParamArray TabValues() 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) = TabValues
    
       '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
       Dim TabValues() As Variant
       Dim Cell As Range
       Dim i As Integer
    
       KillTimer 0, TimerId
    
       Do While SetPropertiesCollection.Count > 0
           TabProperties = SetPropertiesCollection(1)
        
           With TabProperties(1)
               'Set the Cell Value or Range Values
               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 Cells might not exist anymore if deleted
                   On Error Resume Next
                   TabValues = TabProperties(2)
                   i = LBound(TabValues)
                   For Each Cell In .Cells
                       If i > UBound(TabValues) Then
                           Exit For
                       End If
                       Cell.Value = TabValues(i)
                       i = i + 1
                   Next Cell
                   On Error GoTo 0
                
                   ExcelCalculation = False
                
               'Set the Range Properties
               Else
                   If Not TabProperties(2) = NoValue Then .Font.Color = TabProperties(2)
                   If Not TabProperties(3) = NoValue Then
                       If TabProperties(3) = -1 Then
                           .Interior.Pattern = xlNone
                       Else
                           .Interior.Color = TabProperties(3)
                       End If
                   End If
                   If Not TabProperties(4) = NoValue Then .Font.Name = TabProperties(4)
                   If Not TabProperties(5) = NoValue Then .Font.Size = TabProperties(5)
                   If Not TabProperties(6) = NoValue Then .Font.Bold = TabProperties(6)
                   If Not TabProperties(7) = NoValue Then .Font.Italic = TabProperties(7)
                   If Not TabProperties(8) = NoValue Then .Font.Underline = TabProperties(8)
                   If Not TabProperties(9) = NoValue 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.