Option Explicit
 
Type Size
cx As Long
cy As Long
End Type
 
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
 
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long
 
Private Declare Function CreateFontA Lib "gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long
 
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long
 
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
 
Private Declare Function GetTextExtentPoint32A Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long
 
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long
 
 
 
 
Public Function LargeurTexte(Texte As String, Police As String, _
Taille As Double, Optional Gras As Boolean, Optional Italique As Boolean)
 
    Dim hFont As Long
    Dim hDC As Long
    Dim TSize As Size
    Dim PixpInch As Double
     
    hDC = GetDC(0)
    PixpInch = GetDeviceCaps(hDC, 90) / 72
    hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
    400 + 300 * Gras, Italique, 0, 0, 1, 0, 0, 0, 0, Police)
    ' If hFont = 0 Then LgTexte = CVErr(xlErrValue): Exit Function
    If hFont = 0 Then LargeurTexte = 0: Exit Function
    SelectObject hDC, hFont
    GetTextExtentPoint32A hDC, Texte, Len(Texte), TSize
    DeleteObject hFont
    ReleaseDC 0, hDC
    LargeurTexte = TSize.cx
 
End Function