Mise en forme avec l'aide de fonctions

  • Initiateur de la discussion Initiateur de la discussion Magic_Doctor
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Magic_Doctor

XLDnaute Barbatruc
Bonsoir,

J'essaye d'automatiser des mises en forme du style "NumberFormat".
J'ai tenté de la manière suivante :
VB:
Function HowLong(dNum As Double) As Byte
'Renvoie le nombre de chiffres après la virgule

    Dim SepDec$, tmp, posDec
    
    SepDec = Application.International(xlDecimalSeparator)
    tmp = CStr(dNum)
    posDec = InStr(tmp, SepDec)
      
    If posDec = 0 Then
        HowLong = 0
    Else
        HowLong = Len(tmp) - Len(Right(tmp, posDec))
    End If
    
End Function
VB:
Function MFDecApVirg(num As Double, max As Byte, Optional suf As String) As String
'Retourne la syntaxe de MF
'- num : le chiffre à traiter
'- max : le nombre maximal de décimales après la virgule
'- suf : un éventuel suffixe (%, mL...)

    Application.Volatile
    
    Dim x As Byte
    x = HowLong(num)
    
    If x > max Then x = max
    
    If HowLong(num) = 0 Then
        MFDecApVirg = Chr(34) & 0 & Chr(34) & Chr(34)
    Else
        MFDecApVirg = Chr(34) & "0" & Chr(46) & Application.WorksheetFunction.Rept(0, x) & Chr(34) & Chr(34)
    End If
    
    If IsMissing(suf) Then
        MFDecApVirg = MFDecApVirg
    Else
        MFDecApVirg = MFDecApVirg & suf & Chr(34) & Chr(34) & Chr(34)
    End If
    
End Function
VB:
Sub geronimo()

'[I6] = 35,6879
'si j'écris :
[I6].NumberFormat = "0.00"" mL""" 'ça marche, me renvoie 35,69 mL
'[I6].NumberFormat = MFDecApVirg([I6].Value, 2, " mL") 'me renvoie : 0.00 mL
'pourtant MFDecApVirg([I6].Value, 2, " mL") = "0.00"" mL"""

End Sub

Merci d'avance pour tout conseil.
 
Dernière édition:
Re : Mise en forme avec l'aide de fonctions

Salut,

En modifiant ta fonction:
Code:
Function MFDecApVirg(num As Double, max As Byte, Optional suf As String) As String
Set WF = WorksheetFunction
'Retourne la syntaxe de MF
'- num : le chiffre à traiter
'- max : le nombre maximal de décimales après la virgule
'- suf : un éventuel suffixe (%, mL...)
Application.Volatile
Dim x As Byte
x = HowLong(num)
If x > max Then x = max
MFDecApVirg = WF.Round(num, x)
If IsMissing(suf) = False Then MFDecApVirg = MFDecApVirg & " " & suf
End Function

J'connais pas la fonction "chr", du coup, pas pu te mettre l'espace.

++
Hieu
 
Re : Mise en forme avec l'aide de fonctions

Bonjour Magic_Doctor, Hieu,

Et avec ce code? :
VB:
Function MFDecApVirg(num As Double, max As Byte, Optional suf As String) As String
'Retourne la syntaxe de MF
'- num : le chiffre à traiter
'- max : le nombre maximal de décimales après la virgule
'- suf : un éventuel suffixe (%, mL...)

    Application.Volatile
    Dim x As Byte
    x = HowLong(num)
   
    If x > max Then x = max
   
    If HowLong(num) = 0 Then
        MFDecApVirg = "0"
    Else
        MFDecApVirg = "0" & Chr(46) & Application.WorksheetFunction.Rept(0, x)
    End If
   
    If IsMissing(suf) Then
        MFDecApVirg = MFDecApVirg
    Else
        MFDecApVirg = MFDecApVirg & Chr(34) & suf & Chr(34)
    End If
End Function
 
Dernière édition:
Re : Mise en forme avec l'aide de fonctions

Re Magic,

Je retente ma chance :
Code:
Function MFDecApVirg(num As Double, max As Byte, Optional suf As String)

Set WF = WorksheetFunction
'Retourne la syntaxe de MF
'- num : le chiffre à traiter
'- max : le nombre maximal de décimales après la virgule
'- suf : un éventuel suffixe (%, mL...)
Application.Volatile
Dim x As Byte
x = HowLong(num)
If x > max Then x = max
MFDecApVirg = Chr(48) & Chr(46) & WF.Rept(Chr(48), x)
If IsMissing(suf) = False Then _
MFDecApVirg = MFDecApVirg & Chr(34) & Chr(32) & suf & Chr(34)
End Function
 
Bonsoir,

Ayant amélioré cette fonction (qui devrait normalement fonctionner correctement dans tous les cas de figures), en m'inspirant par la même occasion de la syntaxe de Hieu, je partage.
Et si on peut l'améliorer/simplifier, alors TANT MIEUX !
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
163
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Retour