word自定义常用
·
将以下代码保存为“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
更多推荐

所有评论(0)