将以下代码保存为“Word 自定义.exportedUl”使用word选项中的导入工具导入

<mso:cmd app="Word" dt="1" />
<mso:customUI xmlns:x1="http://schemas.microsoft.com/office/2009/07/customui/macro" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui">
   <mso:ribbon>
       <mso:qat>
           <mso:sharedControls>
               <mso:control idQ="mso:AutoSaveSwitch" visible="false"/>
               <mso:control idQ="mso:FileNewDefault" visible="false"/>
               <mso:control idQ="mso:FileOpenUsingBackstage" visible="false"/>
               <mso:control idQ="mso:FileSave" visible="false"/>
               <mso:control idQ="mso:FileSendAsAttachment" visible="false"/>
               <mso:control idQ="mso:FilePrintQuick" visible="false"/>
               <mso:control idQ="mso:PrintPreviewAndPrint" visible="false"/>
               <mso:control idQ="mso:SpellingAndGrammar" visible="false"/>
               <mso:control idQ="mso:ReadAloud" visible="false"/>
               <mso:control idQ="mso:Undo" visible="true"/>
               <mso:control idQ="mso:RedoOrRepeat" visible="true"/>
               <mso:control idQ="mso:TableDrawTable" visible="false"/>
               <mso:control idQ="mso:PointerModeOptions" visible="false"/>
               <mso:control idQ="mso:WritingAssistanceCheckDocument" visible="true"/>
               <mso:control idQ="mso:FileSaveAs" visible="true"/>
           </mso:sharedControls>
       </mso:qat>
       <mso:tabs>
           <mso:tab idQ="mso:TabBlogPost" visible="false"/>
           <mso:tab idQ="mso:TabBlogInsert" visible="false"/>
           <mso:tab id="mso_c1.6B66174" label="常用​​" insertBeforeQ="mso:TabOutlining">
               <mso:group idQ="mso:GroupStyles"/>
               <mso:group id="mso_c3.70955C8" label="批注​​" autoScale="true">
                   <mso:control idQ="mso:ReviewNewComment" visible="true"/>
                   <mso:control idQ="mso:ReviewDeleteCommentsMenu" visible="true"/>
                   <mso:control idQ="mso:ReviewPreviousCommentWord" visible="true"/>
                   <mso:control idQ="mso:ReviewNextCommentWord" visible="true"/>
                   <mso:control idQ="mso:ShowCommentGutter" visible="true"/>
                   <mso:control idQ="mso:PageBreakInsertWord" visible="true"/>
                   <mso:button idQ="x1:ClearSelectedFormatting_0_62B900A" label="清除格式​​" imageMso="InkEraseMode" onAction="ClearSelectedFormatting" visible="true"/>
               </mso:group>
               <mso:group id="mso_c2.6B66174" label="文字与段落​​" autoScale="true">
                   <mso:control idQ="mso:FormatPainter" visible="true"/>
                   <mso:control idQ="mso:Font" visible="true"/>
                   <mso:control idQ="mso:FontSize" visible="true"/>
                   <mso:gallery idQ="mso:FontColorPicker" showInRibbon="false" visible="true"/>
               </mso:group>
               <mso:group id="mso_c1.6C7B4B2" label="页面​​" autoScale="true">
                   <mso:gallery idQ="mso:BreaksGallery" showInRibbon="false" visible="true"/>
                   <mso:control idQ="mso:DarkModeOn" visible="true"/>
               </mso:group>
               <mso:group id="mso_c1.6F9D6DD" label="窗口​​" imageMso="CopyFolder" autoScale="true">
                   <mso:control idQ="mso:WindowNew" visible="true"/>
                   <mso:control idQ="mso:WindowsArrangeAll" visible="true"/>
                   <mso:control idQ="mso:WindowSplit" visible="true"/>
                   <mso:control idQ="mso:WindowSideBySide" visible="true"/>
                   <mso:control idQ="mso:WindowSideBySideSynchronousScrolling" visible="true"/>
                   <mso:control idQ="mso:WindowSwitchWindowsMenuWord" visible="true"/>
               </mso:group>
               <mso:group id="mso_c1.26D9561A" label="自定义​​" autoScale="true">
                   <mso:button idQ="x1:IndentSelectedContentFirstLineTwoCharsUsingCharacterUnits_0_13B1F42C" label="首行缩进2个字符" imageMso="ViewGoForward" onAction="IndentSelectedContentFirstLineTwoCharsUsingCharacterUnits" visible="true"/>
                   <mso:button idQ="x1:SetPicturesWidthTo14cmKeepRatio_0_114C84DD" label="图片14cm宽" imageMso="ListMacros" onAction="SetPicturesWidthTo14cmKeepRatio" visible="true"/>
                   <mso:button idQ="x1:RemoveAllHyperlinks_0_114B1DDB" label="去除所有超链接" imageMso="ListMacros" onAction="RemoveAllHyperlinks" visible="true"/>
                   <mso:button idQ="x1:RemoveParagraphShadingAndColor_0_186177BC" label="去除底纹颜色" imageMso="ViewSheetGridlines" onAction="RemoveParagraphShadingAndColor" visible="true"/>
                   <mso:button idQ="x1:table100_0_185E5B39" label="表格百分百​​" imageMso="ListMacros" onAction="table100" visible="true"/>
               </mso:group>
               <mso:group idQ="mso:GroupParagraph"/>
               <mso:group idQ="mso:GroupTableAlignment"/>
           </mso:tab>
           <mso:tab idQ="mso:TabInsert">
               <mso:group idQ="mso:GroupInsertPages" visible="false"/>
           </mso:tab>
           <mso:tab idQ="mso:TabDrawInk" visible="false"/>
           <mso:tab idQ="mso:TabReviewWord">
               <mso:group idQ="mso:GroupComments" visible="false"/>
           </mso:tab>
           <mso:tab idQ="mso:HelpTab" visible="false"/>
       </mso:tabs>
   </mso:ribbon>
</mso:customUI>

常用宏可自行验证,内容如下,使用方法自查(可能的化会增加wps的宏):


Sub 图片14cm()
    Dim doc As Document
    Dim inlineShape As inlineShape
    Dim shape As shape
    Dim targetWidthCm As Single
    Dim currentWidthCm As Single
    Dim currentHeightCm As Single
    Dim newHeightCm As Single

    ' 设置目标宽度(14厘米)
    targetWidthCm = 14

    ' 获取当前活动文档
    Set doc = ActiveDocument

    ' 遍历所有内嵌图片
    For Each inlineShape In doc.InlineShapes
        ' 将厘米转换为磅(1厘米 = 28.3464567磅)
        currentWidthCm = inlineShape.Width / 28.3464567
        currentHeightCm = inlineShape.Height / 28.3464567

        ' 计算新的高度以保持宽高比
        newHeightCm = (targetWidthCm / currentWidthCm) * currentHeightCm

        ' 设置新的宽度和高度
        inlineShape.LockAspectRatio = msoTrue
        inlineShape.Width = targetWidthCm * 28.3464567
        inlineShape.Height = newHeightCm * 28.3464567
    Next inlineShape

    ' 遍历所有浮动图片
    For Each shape In doc.Shapes
        ' 将厘米转换为磅(1厘米 = 28.3464567磅)
        currentWidthCm = shape.Width / 28.3464567
        currentHeightCm = shape.Height / 28.3464567

        ' 计算新的高度以保持宽高比
        newHeightCm = (targetWidthCm / currentWidthCm) * currentHeightCm

        ' 设置新的宽度和高度
        shape.LockAspectRatio = msoTrue
        shape.Width = targetWidthCm * 28.3464567
        shape.Height = newHeightCm * 28.3464567
    Next shape

    MsgBox "图片已调整为14厘米宽,同时保持宽高比。"
End Sub

Sub 设置表格中字体为五号字()
    Dim doc As Document
    Dim tbl As Table
    Dim cell As cell
    Dim rng As Range
    
    ' 获取当前文档
    Set doc = ActiveDocument
    
    ' 遍历文档中的所有表格
    For Each tbl In doc.Tables
        ' 遍历表格中的所有单元格
        For Each cell In tbl.Range.Cells
            ' 获取单元格中的文本范围
            Set rng = cell.Range
            
            ' 设置文本的字号为10.5磅(中文五号字)
            rng.Font.Size = 10.5
        Next cell
    Next tbl
    
    MsgBox "所有表格中的文字字号已成功设置为中文五号字。", vbInformation
End Sub

Sub 表格100()
    Dim tbl As Table
    Dim doc As Document
    Dim currentWidth As Single
    
    ' 设置当前文档
    Set doc = ActiveDocument
    
    ' 遍历文档中的所有表格
    For Each tbl In doc.Tables
        ' 获取表格的当前宽度
        currentWidth = tbl.PreferredWidth
        
        ' 检查表格的当前宽度是否大于90%
        If currentWidth > 90 Then
            ' 将表格的宽度设置为100%页面宽度
            tbl.PreferredWidthType = wdPreferredWidthPercent
            tbl.PreferredWidth = 100
            
            ' 移除表格的左缩进
            tbl.Rows.LeftIndent = 0
        End If
    Next tbl
    
    MsgBox "所有符合条件的表格的总宽度已设置为100%,并且左缩进已被移除。", vbInformation
End Sub

Sub 表格1001()
    Dim tbl As Table
    Dim doc As Document
    Dim currentWidth As Single
    Dim isPercent As Boolean
    
    ' 设置当前文档
    Set doc = ActiveDocument
    
    ' 遍历文档中的所有表格
    For Each tbl In doc.Tables
        ' 获取表格的当前宽度类型
        isPercent = (tbl.PreferredWidthType = wdPreferredWidthPercent)
        
        ' 获取表格的当前宽度
        If isPercent Then
            currentWidth = tbl.PreferredWidth
        Else
            ' 如果当前宽度是磅,则需要转换为百分比
            currentWidth = tbl.PreferredWidth / doc.PageSetup.PageWidth * 100
        End If
        
        ' 检查表格的当前宽度是否大于90%
        If currentWidth > 90 Then
            ' 将表格的宽度设置为100%页面宽度
            tbl.PreferredWidthType = wdPreferredWidthPercent
            tbl.PreferredWidth = 100
            
            ' 移除表格的左缩进
            tbl.Rows.LeftIndent = 0
        End If
    Next tbl
    
    MsgBox "所有符合条件的表格的总宽度已设置为100%,并且左缩进已被移除。", vbInformation
End Sub
Sub 左缩进0()
    Dim para As Paragraph
    Dim tbl As Table
    Dim shp As inlineShape
    Dim shpObj As shape

    ' 设置段落的左缩进
    For Each para In ActiveDocument.Paragraphs
        para.LeftIndent = 0
    Next para

    ' 设置表格的左缩进
    For Each tbl In ActiveDocument.Tables
        tbl.LeftPadding = 0
        tbl.Rows.LeftIndent = 0
    Next tbl

    ' 设置内嵌形状(如图片)的左缩进
    For Each shp In ActiveDocument.InlineShapes
       ' shp. = wdShapeCenter
   '     shp.RelativeHorizontalPosition = wdRelativeHorizontalPositionColumn
  '      shp.Left = 0
   ' 设置左缩进为0
        inlineShape.Range.ParagraphFormat.LeftIndent = 0
    Next shp

    ' 设置非内嵌形状的左缩进
    For Each shpObj In ActiveDocument.Shapes
        shpObj.Left = 0
    Next shpObj

    MsgBox "所有元素的左缩进已设置为0。", vbInformation
End Sub

    

Sub SetLeftIndentToZero()
    Dim para As Paragraph
    ' 遍历文档中的每一个段落
    For Each para In ActiveDocument.Paragraphs
        ' 设置段落的左缩进为0
        para.LeftIndent = 0
    Next para
     For Each para In ActiveDocument.Paragraphs
            ' 设置左缩进为0
            para.Range.ParagraphFormat.LeftIndent = 0
        Next para
End Sub

Sub 空2转首行()
    Dim para As Paragraph
    Dim startSpaceCount As Integer
    Dim text As String
    
    ' 遍历文档中的每一个段落
    For Each para In ActiveDocument.Paragraphs
        ' 获取段落的文本
        text = para.Range.text
        
        ' 计算段首的空格数
        startSpaceCount = 0
        While Left(text, 1) = " " And startSpaceCount < Len(text)
            startSpaceCount = startSpaceCount + 1
            text = Mid(text, 2)
        Wend
        
        ' 如果段首有2个或以上的空格
        If startSpaceCount >= 2 Then
            ' 删除段首的空格
            With para.Range.Find
                .text = Space(startSpaceCount)
                .Replacement.text = ""
                .Forward = True
                .Wrap = wdFindStop
                .Execute Replace:=wdReplaceOne
            End With
            
            ' 设置首行缩进
            para.LeftIndent = CentimetersToPoints(0)
            para.FirstLineIndent = CentimetersToPoints(0.2 * 2) ' 0.2厘米约等于一个中文字符宽度
        End If
    Next para
End Sub

Sub 刷新所有域()
    Dim doc As Document
    Set doc = ActiveDocument

    ' 更新文档中的所有域
    doc.Fields.Update
    
    MsgBox "所有域已刷新。", vbInformation
End Sub
Sub FindFontAndHighlight()
    Dim doc As Document
    Dim rng As Range
    Dim i As Long
    Dim fontName As String
    Dim foundCount As Integer
    
    ' 获取当前文档
    Set doc = ThisDocument
    Set rng = doc.Content
    
    ' 提示用户输入要查找的字体名称
    fontName = InputBox("请输入要查找的字体名称:", "查找字体")
    
    If fontName = "" Then
        MsgBox "未输入字体名称,宏已终止。", vbInformation
        Exit Sub
    End If
    
    ' 初始化计数器
    foundCount = 0
    
    ' 遍历文档中的每个字符
    For i = 1 To rng.Characters.Count
        ' 获取当前字符的字体信息
        Set rng = rng.Characters(i)
        
        If rng.Font.Name = fontName Then
            ' 扩展范围以包含当前字符
            Set rng = rng.Duplicate
            rng.MoveStart Unit:=wdCharacter, Count:=-1
            
            ' 高亮显示匹配的字体(背景色为黄色)
            rng.HighlightColorIndex = wdYellow
            
            ' 计数增加
            foundCount = foundCount + 1
        End If
    Next i
    
    ' 提示用户查找结果
    If foundCount > 0 Then
        MsgBox "共找到 " & foundCount & " 处 '" & fontName & "' 字体,并已高亮显示。", vbInformation
    Else
        MsgBox "未找到 '" & fontName & "' 字体。", vbInformation
    End If
End Sub

更多推荐