边框溢出文本的条件格式

Question

就像我的标题所说，我需要一个条件格式公式，它将我指定的边框应用于包含溢出文本的单元格。这可能吗？

我有一个公式可以将边框应用于包含文本的单元格，效果很好，但边框不会扩展到其中包含溢出文本的单元格。

谢谢

Answer 1

选项 1：简单的解决方案

使用 Gordon 的想法，如果您使用等宽字体（例如 Courrier New），您可以计算溢出单元格所需的字符数并使用单元格中的字符数（通过 @987654324 @函数）来创建你的条件格式。

例如，如果您使用的是 Courrier New，尺寸为 11，列宽为常规列宽（8.43，64 像素），您可以在单元格溢出之前容纳 6 个字符。

所以条件格式公式如下所示：

=LEN(B2)>6

---

选项 2：更复杂的解决方案

您可以创建一个 VBA 函数，使用this answer 中提供的方法确定单元格中文本的像素宽度，然后将其与以像素为单位的列宽进行比较。如果 TextWidth > ColumnWidth 则返回 TRUE。

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

要获得文本的像素宽度，您必须将其包含在（单独的）模块中：

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

最后，您将在自定义条件格式公式中使用DetectOverflowTextWidth 来确定是否应用了条件格式。

免责声明：选项 2 使用某些 Windows API 函数，如果处理不当，可能会导致内存泄漏。我在原始答案中添加了一些错误处理，以降低出现问题的风险，但仍需牢记这一点。