word或WPS文字的vba代码分享

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