等字符长度字符串视觉宽度不一致如何生成规整统一的Excel文件名

实现方案 #

你当前的问题根源是按字符数对齐，但Windows文件资源管理器默认使用可变宽度的比例字体渲染文件名，不同字符（大小写字母、符号）的像素宽度存在差异，因此字符数相等不代表视觉宽度一致，确实需要基于实际像素宽度计算补位字符数量。

具体实现步骤 #

1. 核心原理

VBA本身没有直接测量文本像素宽度的方法，我们可以调用Windows GDI API实现，测量时直接指定资源管理器默认的Segoe UI 9号字体，测量结果和实际显示效果完全匹配，API会自动区分大小写、不同字符的宽度差异，无需手动单独计算每个字符的宽度。

2. 完整VBA代码示例

' 64位/32位Office兼容的API声明
#If VBA7 Then
    Private Declare PtrSafe Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As LongPtr
    Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
    Private Declare PtrSafe Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As LongPtr, ByVal lpszString As String, ByVal cbString As Long, lpSize As SIZE) As Long
    Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
#Else
    Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As Long, ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic As Boolean, ByVal fdwUnderline As Boolean, ByVal fdwStrikeOut As Boolean, ByVal fdwCharSet As Long, ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal lpszFace As String) As Long
    Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
    Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As SIZE) As Long
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    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
#End If

Private Type SIZE
    cx As Long
    cy As Long
End Type

' 测量指定字符串在资源管理器默认字体下的像素宽度
Function GetTextPixelWidth(ByVal strText As String) As Long
    #If VBA7 Then
        Dim hdc As LongPtr, hFont As LongPtr, hOldFont As LongPtr
    #Else
        Dim hdc As Long, hFont As Long, hOldFont As Long
    #End If
    Dim sz As SIZE
    hdc = GetDC(0)
    ' 创建Segoe UI 9号字体，对应资源管理器默认显示字体
    hFont = CreateFont(-12, 0, 0, 0, 400, False, False, False, 1, 0, 0, 0, 0, "Segoe UI")
    hOldFont = SelectObject(hdc, hFont)
    GetTextExtentPoint32 hdc, strText, Len(strText), sz
    GetTextPixelWidth = sz.cx
    ' 释放资源，避免内存泄漏
    SelectObject hdc, hOldFont
    DeleteObject hFont
    ReleaseDC 0, hdc
End Function

' 生成视觉等宽的文件名
Function GenerateVisualEqualName(ByVal baseName As String, ByVal suffix As String, ByVal maxWidth As Long, Optional padChar As String = "-") As String
    Dim currentWidth As Long, padCharWidth As Long, padCount As Long
    currentWidth = GetTextPixelWidth(baseName & suffix)
    padCharWidth = GetTextPixelWidth(padChar)
    If currentWidth >= maxWidth Then
        GenerateVisualEqualName = baseName & suffix
        Exit Function
    End If
    ' 计算需要补的字符数量
    padCount = (maxWidth - currentWidth) \ padCharWidth
    GenerateVisualEqualName = baseName & String(padCount, padChar) & suffix
End Function

3. 使用方法

1. 先遍历所有需要生成的文件名（即你原逻辑里的TRIM(A2)&TRIM(B2)&"_.pdf"部分，先不带补位的短横线），调用GetTextPixelWidth测量每个的宽度，找到所有文件名中的最大宽度值maxWidth
2. 对每个文件名，调用GenerateVisualEqualName，传入不带补位的基础名称、后缀、最大宽度，就能得到视觉等宽的文件名

注意事项 #

• 如果你的系统文件管理器自定义了显示字体，只需要修改CreateFont里的字体名称和字号参数即可
• 补位字符如果不想用短横线，也可以改成全角空格或者其他符号，修改padChar参数就行
• 不需要手动区分大小写计算宽度，API测量时已经自动包含了不同字符的宽度差异，结果和实际显示完全一致

内容的提问来源于stack exchange，提问作者Capt.Krusty