Like my title says, I need a formula for conditional formatting that will apply my specified border on cells that contain overflow text. Is this possible?
I have a formula that applies a border to cells that contain text, and it works great, but the border won't extend to a cell that has overflow text in it.
Thanks
Using Gordon's idea, if you use a mono-spaced font (like Courrier New for instance), you could count the number of characters it takes to overflow the cell and use the number of characters in the cells (via the LEN function) to create your conditional formatting.
For example, if you are using Courrier New with size 11 and regular column width (8.43, 64 pixels), you could fit 6 characters before the cell overflows.
So the conditional formatting formula would look like this:
=LEN(B2)>6
You could create a VBA function that determines the pixel width of the text in the cell using the method provided in this answer and then compare it with the column width in pixels. Then return TRUE if TextWidth > ColumnWidth.
Public Function DetectOverflowTextWidth(c As Range) As Boolean
'Get column size in pixels
Dim ColumnWidth As Long
ColumnWidth = (c.EntireColumn.Width / 72) * c.Parent.Parent.WebOptions.PixelsPerInch
'Get Text size in pixels
Dim TextWidth As Long
TextWidth = GetStringPixelWidth(c.Value2, c.font.Name, c.font.Size, c.font.Bold, c.font.Italic)
If ColumnWidth < TextWidth Then DetectOverflowTextWidth = True
End Function
And to have the pixel width of the text you'd have to include this in a (seperate) module:
Option Explicit
'API Declares
#If VBA7 Then
Declare PtrSafe Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As LongPtr) As LongPtr
Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Declare PtrSafe Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As LongPtr
Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As LongPtr, ByVal lpsz As String, ByVal cbString As Long, lpSize As FNTSIZE) As Long
Declare PtrSafe Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As LongPtr, ByVal nIndex As Long) As Long
Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
#Else
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32.dll" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32.dll" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As FNTSIZE) As Long
Private Declare Function MulDiv Lib "kernel32.dll" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32.dll" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
#End If
Private Const LOGPIXELSY As Long = 90
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName As String * 32
End Type
Private Type FNTSIZE
cx As Long
cy As Long
End Type
Private Sub test()
MsgBox (GetStringPixelWidth("Test String", "Calibri", 10))
MsgBox (GetStringPixelWidth(" ", "Calibri", 10, True, False))
End Sub
Public Function GetStringPixelHeight(text As String, fontName As String, fontSize As Single, Optional isBold As Boolean = False, Optional isItalics As Boolean = False) As Integer
Dim font As New StdFont
Dim sz As FNTSIZE
font.Name = fontName
font.Size = fontSize
font.Bold = isBold
font.Italic = isItalics
sz = GetLabelSize(text, font)
GetStringPixelHeight = sz.cy
End Function
Public Function GetStringPixelWidth(text As String, fontName As String, fontSize As Single, Optional isBold As Boolean = False, Optional isItalics As Boolean = False) As Integer
Dim font As New StdFont
Dim sz As FNTSIZE
font.Name = fontName
font.Size = fontSize
font.Bold = isBold
font.Italic = isItalics
sz = GetLabelSize(text, font)
GetStringPixelWidth = sz.cx
End Function
Private Function GetLabelSize(text As String, font As StdFont) As FNTSIZE
#If VBA7 Then
Dim tempDC As LongPtr
Dim tempBMP As LongPtr
Dim f As LongPtr
#Else
Dim tempDC As Long
Dim tempBMP As Long
Dim f As Long
#End If
Dim lf As LOGFONT
Dim textSize As FNTSIZE
On Error GoTo CleanUp
' Create a device context and a bitmap that can be used to store a
' temporary font object
tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)
' Assign the bitmap to the device context
DeleteObject SelectObject(tempDC, tempBMP)
' Set up the LOGFONT structure and create the font
lf.lfFaceName = font.Name & chr$(0)
lf.lfHeight = -MulDiv(font.Size, GetDeviceCaps(GetDC(0), 90), 72) 'LOGPIXELSY
lf.lfItalic = font.Italic
lf.lfStrikeOut = font.Strikethrough
lf.lfUnderline = font.Underline
If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
f = CreateFontIndirect(lf)
' Assign the font to the device context
DeleteObject SelectObject(tempDC, f)
' Measure the text, and return it into the textSize SIZE structure
GetTextExtentPoint32 tempDC, text, Len(text), textSize
CleanUp:
' Clean up (very important to avoid memory leaks!)
DeleteObject f
DeleteObject tempBMP
DeleteDC tempDC
' Return the measurements
GetLabelSize = textSize
End Function
Finally, you'd use DetectOverflowTextWidth inside your custom conditional formatting formula to determine if the conditional formatting is applied.
Disclaimer: Option 2 is using certain Windows API functions and this could lead to memory leaks if not handled properly. I've added some error handling to the original answer to reduce the risks of it being a problem, but it's still something to keep in mind.
