边界溢出文本的条件格式

Question

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

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

由于

Answer 1

选项1：简单的解决方案

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

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

因此条件格式公式如下：

LEN

---

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

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

=LEN(B2)>6

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

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 来确定是否应用了条件格式。

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