1、word或wps文字中表格统一根据窗口自动调整
Sub 短单元格样式()
'
'功能:修改当前文档中字数少于一定数量的表格单元格内容样式
'
Dim objDoc As Document
Dim objTable As Table
Dim objCell As Cell
Dim cellText As String
Dim cellContent As String
Dim count As Integer
Dim wordCount As Integer
Dim styleName As String
' 设置引用
Set objDoc = ActiveDocument
count = 0
' 检查文档是否包含表格
If objDoc.Tables.count = 0 Then
MsgBox "文档中没有表格!", vbExclamation
Exit Sub
End If
' 用户输入与验证
wordCount= InputBox("请输入字数边界(少于等于此数量则应用样式):", "短单元格改样式", "40")
styleName = InputBox("请输入样式名称:", "短单元格样式", "")
' 判断样式是否存在
If styleName = "" Then Exit Sub ' 用户取消输入
If Not StyleExists(styleName) Then
MsgBox "不存在 [" & styleName & "] 样式。"
Exit Sub
End If
Application.ScreenUpdating = False '关闭屏幕刷新
' 遍历所有表格
For Each objTable In objDoc.Tables
' 遍历表格中的每个单元格
For Each objCell In objTable.Range.Cells
cellContent = objCell.Range.Text
cellContent = Replace(cellContent, vbCr, "") ' 移除段落标记
cellContent = Trim(cellContent) ' 去除首尾空格
' 检查字数是否超出
If Len(cellContent) <= wordCount Then
' 更改样式
objCell.Range.Style = styleName
End If
Next objCell
Next objTable
' 释放对象
Set objDoc = Nothing
Application.ScreenUpdating = True '开启屏幕刷新
MsgBox "更改完成"
End Sub
Function StyleExists(styleName As String) As Boolean
On Error Resume Next
StyleExists = Not ActiveDocument.Styles(styleName) Is Nothing
On Error GoTo 0
End Function