Hi，大家好！
五一假期结束，收收心，继续搞 Access。
用 Excel 做表的人应该都知道一个很方便的小功能：单元格格式里有个「缩小字体填充」，勾上之后文字太长就自动把字号缩小，不用手动调列宽，内容也不会被截断。
回到 Access，报表里其实有完全一样的需求——文本框列宽固定，数据长度千差万别。比如产品名称，短的叫「螺栓」两个字，长的叫「M12×123 304 不锈钢六角螺栓全螺纹带螺母平垫」二十几个字。列宽设窄了长内容截断，设宽了短内容后面空一大片。
但 Access 偏偏没有这个选项。
没关系，自己做一个。本文从零实现一个模块，在 Access 窗体和报表中实现和 Excel 一样的「缩小字体填充」效果——文本框宽度不变，文字太长时自动缩小字号，刚好完整显示在框内。
比如产品名称，最短的两个字，最长的二十几个字。列宽设窄了长内容被截断，设宽了版面塞不下。让用户每次手工调字号也不现实——几十页的报表，每条记录长度都不同。
如果在 Access 里能做到：文本框宽度不变，文字太长时自动把字号缩小，刚好完整显示在框内——体验会好很多。
这就是文字自适应（Text Auto-Size），和 Excel 的「缩小字体填充」效果类似。本文从零实现一个模块，在 Access 窗体和报表中按内容长度自动调节字号。
技术原理分析
核心逻辑是逐级缩小：
| 步骤 | 做什么 |
|---|
| 1 | 用 GDI 测量文本在当前字号下的渲染宽度 |
| 2 | 如果宽度 ≤ 文本框可用宽度 → 当前字号 OK，不调整 |
| 3 | 如果宽度 > 可用宽度 → 字号减 1 磅，回到步骤 1 |
| 4 | 重复直到文本能完整显示，或字号触及最小底线 |
不是简单按字符数线性缩——那样中英文混排会翻车。每一步都要用 GDI 真实测量渲染宽度，然后决定是否继续缩小。
测量仍然靠 Win32 API，但和之前不一样的是：这次控制变量是字号，测完不是设 .Width，而是设 .FontSize。
实现步骤
在 VBA 编辑器中新建标准模块，命名为 basTextAutoFit，复制以下完整代码：
OptionCompare DatabaseOptionExplicit' ============================================' 模块: basTextAutoFit' 用途: 文本框文字自适应——宽度固定，' 内容过长时自动缩小字号，直到装下' 场景: 报表中的固定列宽文本框、标签等' 说明: 通过 GDI Unicode API 逐级测量，' 字号从大到小递减，找到能完整显示' 内容的最大字号' ============================================' === API 声明（32/64 位兼容，Unicode 版本） ===#If VBA7 ThenPrivateDeclare PtrSafe Function CreateFontIndirectW Lib"gdi32" (lpLogFont As LOGFONT) As LongPtrPrivateDeclare PtrSafe Function GetTextExtentPoint32W Lib"gdi32" (ByVal hDC As LongPtr, ByVal lpString As LongPtr, ByVal c AsLong, lpSize As SIZE) AsLongPrivateDeclare PtrSafe Function GetDC Lib"user32" (ByVal hwnd As LongPtr) As LongPtrPrivateDeclare PtrSafe Function ReleaseDC Lib"user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) AsLongPrivateDeclare PtrSafe Function SelectObject Lib"gdi32" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As LongPtrPrivateDeclare PtrSafe Function DeleteObject Lib"gdi32" (ByVal hObject As LongPtr) AsLongPrivateDeclare PtrSafe Function GetDeviceCaps Lib"gdi32" (ByVal hDC As LongPtr, ByVal nIndex AsLong) AsLongPrivateDeclare PtrSafe Function MulDiv Lib"kernel32" (ByVal nNumber AsLong, ByVal nNumerator AsLong, ByVal nDenominator AsLong) AsLong#ElsePrivateDeclareFunction CreateFontIndirectW Lib"gdi32" (lpLogFont As LOGFONT) AsLongPrivateDeclareFunction GetTextExtentPoint32W Lib"gdi32" (ByVal hDC AsLong, ByVal lpString AsLong, ByVal c AsLong, lpSize As SIZE) AsLongPrivateDeclareFunction GetDC Lib"user32" (ByVal hwnd AsLong) AsLongPrivateDeclareFunction ReleaseDC Lib"user32" (ByVal hwnd AsLong, ByVal hDC AsLong) AsLongPrivateDeclareFunction SelectObject Lib"gdi32" (ByVal hDC AsLong, ByVal hObject AsLong) AsLongPrivateDeclareFunction DeleteObject Lib"gdi32" (ByVal hObject AsLong) AsLongPrivateDeclareFunction GetDeviceCaps Lib"gdi32" (ByVal hDC AsLong, ByVal nIndex AsLong) AsLongPrivateDeclareFunction MulDiv Lib"kernel32" (ByVal nNumber AsLong, ByVal nNumerator AsLong, ByVal nDenominator AsLong) AsLong#EndIf' === 结构体 ===Private Type LOGFONT lfHeight AsLong lfWidth AsLong lfEscapement AsLong lfOrientation AsLong lfWeight AsLong lfItalic AsByte lfUnderline AsByte lfStrikeOut AsByte lfCharSet AsByte lfOutPrecision AsByte lfClipPrecision AsByte lfQuality AsByte lfPitchAndFamily AsByte lfFaceName AsString * 32End TypePrivate Type SIZE cx AsLong cy AsLongEnd Type' === 常量 ===PrivateConst LOGPIXELSY AsLong = 90PrivateConst FW_NORMAL AsLong = 400PrivateConst FW_BOLD AsLong = 700' ============================================' 公开方法' ============================================' 函数说明: 固定文本框宽度，自动缩小字号以适应内容' 参数: txt - 目标文本框' lMinFont - 最小字号（磅），缩到此后不再缩小，默认 6' lPadding - 左右内边距（缇），文本与边框之间的留白，默认 60' 返回: 最终应用的字号（磅）' 说明: 如果内容为空或已能完整显示，保持原字号不变PublicFunction AutoFontSize(ByRef txt As Access.TextBox, _OptionalByVal lMinFont AsLong = 6, _OptionalByVal lPadding AsLong = 60) AsDoubleOnErrorGoTo ErrHandlerDim sText AsString sText = Nz(txt.Value, "") AutoFontSize = txt.FontSize' 空内容无需调整If Len(sText) = 0ThenExitFunction' 可用宽度 = 控件宽度 - 左右内边距Dim lAvailWidth AsLong lAvailWidth = txt.Width - lPadding * 2If lAvailWidth <= 0ThenExitFunctionDim dFontSize AsDouble dFontSize = txt.FontSize' 当前字号已经能装下，不用调If TextWidthTwips(sText, txt.FontName, dFontSize, txt.FontBold, txt.FontItalic) <= lAvailWidth ThenExitFunctionEndIf' 逐级缩小，直到文字能装下或触底DoWhile dFontSize > lMinFont dFontSize = dFontSize - 1If TextWidthTwips(sText, txt.FontName, dFontSize, txt.FontBold, txt.FontItalic) <= lAvailWidth ThenExitDoEndIfLoop txt.FontSize = dFontSize AutoFontSize = dFontSizeExitFunctionErrHandler: AutoFontSize = txt.FontSizeEndFunction' 函数说明: 对窗体/报表上所有文本框批量自适应字号' 参数: frm - 目标 Form 或 Report 对象PublicSub AutoFontSizeAll(ByRef frm AsObject)Dim ctl As ControlForEach ctl In frm.ControlsIf ctl.ControlType = acTextBox Then AutoFontSize ctlEndIfNext ctlEndSub' ============================================' 核心测量函数' ============================================' 函数说明: 测量指定文本在给定字号下的渲染宽度' 使用 GDI Unicode API，中文宽度准确PrivateFunction TextWidthTwips(ByVal sText AsString, _ByVal sFontName AsString, _ByVal dFontSize AsDouble, _ByVal bBold AsBoolean, _ByVal bItalic AsBoolean) AsLongOnErrorGoTo FailDim hDC As LongPtrDim hFont As LongPtrDim hOldFont As LongPtrDim lf As LOGFONTDim sz As SIZEDim dpiY AsLong TextWidthTwips = 0 hDC = GetDC(0)If hDC = 0ThenExitFunction dpiY = GetDeviceCaps(hDC, LOGPIXELSY)' 构建字体：传入的字号是多少磅，就按多少磅建 GDI 字体 lf.lfHeight = -MulDiv(CLng(dFontSize), dpiY, 72) lf.lfWidth = 0 lf.lfWeight = IIf(bBold, FW_BOLD, FW_NORMAL) lf.lfItalic = IIf(bItalic, 1, 0) lf.lfCharSet = 1 lf.lfFaceName = sFontName & vbNullChar hFont = CreateFontIndirectW(lf)If hFont = 0ThenGoTo Cleanup hOldFont = SelectObject(hDC, hFont)' 关键：StrPtr 传 Unicode 指针，中文宽度不失真 GetTextExtentPoint32W hDC, StrPtr(sText), Len(sText), sz SelectObject hDC, hOldFont' 像素 → 缇 TextWidthTwips = MulDiv(sz.cx, 1440, dpiY)Cleanup:If hFont <> 0Then DeleteObject hFont ReleaseDC 0, hDCExitFunctionFail: TextWidthTwips = 0Resume CleanupEndFunction
窗体场景
' 加载记录时自动适配PrivateSub Form_Current() AutoFontSize Me.txtProductName AutoFontSize Me.txtSpecEndSub
报表场景
报表的文本框自适应要在 Detail_Format 事件中调用，因为报表每行数据在格式化时才会赋值：
' 报表每行格式化时触发PrivateSub Detail_Format(Cancel AsInteger, FormatCount AsInteger) AutoFontSize Me.txtProductName, 6 AutoFontSize Me.txtSpec, 6EndSub
也可以批量处理：
PrivateSub Detail_Format(Cancel AsInteger, FormatCount AsInteger) AutoFontSizeAll MeEndSub
假设文本框宽度 2880 缇（2 英寸），默认 11pt 等线字体：
| 内容 | 11pt 宽度 | 适配结果 |
|---|
| 「螺栓」 | ≈ 400 缇 | 保持 11pt（已经装得下） |
| 「M12×60 不锈钢六角螺栓」 | ≈ 2800 缇 | 保持 11pt（刚好） |
| 「M12×60 不锈钢六角螺栓（全螺纹）」 | ≈ 3400 缇 | 缩到 9pt |
| 「M12×60 304 不锈钢六角螺栓全螺纹带螺母平垫」 | ≈ 4500 缇 | 缩到 7pt |
短内容保持原字号不缩，长内容逐级缩小直到装下——每一条记录都找到刚好够用的字号。
为什么逐级降而不是二分查找？
两种方案对比：
| 方案 | 测量次数 | 优点 | 缺点 |
|---|
| 逐级降（每次减 1pt） | 最多约 10 次 | 代码简单，结果稳定 | 极长文本多量几次 |
| 二分查找 | 约 4-5 次 | 快 | 逻辑复杂，边界条件多 |
实际场景中，文本框宽度通常是设计好的合理值，大多数内容在当前字号下就能显示，只有少数超长记录需要缩一两磅。逐级降的方案够用且不易出错。
如果数据里大量内容需要从 20 pt 缩到 6 pt，可以改为二分查找减少测量次数。但在常规报表场景中不需要。
注意点
报表里一定要用 Detail_Format 事件，不是 Detail_Print。Format 在数据绑定后、分页计算前触发，此时修改字号 Access 会重新计算布局；Print 只是渲染阶段，改了不生效。
最小字号不要设太低。 默认 6pt 是打印可读的底线。如果 6pt 还装不下，应该调整的是列宽或数据截断策略，而不是继续缩。
字号是离散值。FontSize 属性接受小数，但逐级减 1pt 的整数步进在视觉上更统一。如果需要 0.5pt 精度，把 dFontSize = dFontSize - 1 改成 dFontSize = dFontSize - 0.5 即可。
报表里字号缩小后，行高不会自动变。 如果原行高是按 11pt 设计的，缩到 7pt 后文字上方会显得空旷。可以在 Detail_Format 中同步调整 Detail.Height，或保持统一行高接受留白。
换行符不处理。 本文只针对单行内容做字号自适应。如果文本框 EnterKeyBehavior = True 且内容含换行符，TextWidthTwips 测量的是最长那一行的宽度，配合多行高度自适应需要额外处理，不在本文范围内。
本文实现了一个文本框字号自适应模块，代码不到 100 行，核心思路：
固定文本框宽度，用 GDI Unicode API 测量文本在不同字号下的渲染宽度。
从当前字号逐级递减，找到刚好能完整显示内容的最大字号。
设置 txt.FontSize，控件尺寸不变，内容自动适应。
一行 AutoFontSize Me.txtXXX 就能让报表里的长文本自动缩小，不被截断，也不用放大列宽。
测试环境：Access 2010 及以上版本，Windows 7/10/11。
社区版 Access 开发框架已开放下载。 关注公众号或添加微信 Access开发 即可获取，欢迎下载测试。
如果你的团队正在用 Access，或者计划用 Access 搭建业务系统，我们可以提供从培训到落地的全流程支持：
📚 技术培训
💼 定制开发
🔧 技术支持
无论是想让团队快速上手 Access 开发，还是需要把现有系统接上 AI，都可以直接联系我们聊聊方案。
联系方式：
