哪位大神能够添加“查找文中一、二级标题并加粗“的代码？

lhteee

Sub 标准格式设置()
'
' 格式设置 Macro
' 宏在 2008-9-23 由 陈凯 制作
'
    Application.ScreenUpdating = False
    '更改所有硬回车为软回车
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '去除所有空行
    Dim i As Paragraph, n As Integer
    Application.ScreenUpdating = False
    For Each i In ActiveDocument.Paragraphs
    If Len(i.Range) = 1 Then
    i.Range.Delete
    n = n + 1
    End If
    Next
    Application.ScreenUpdating = True
    '去除半角空格
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " "
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '去除全角空格
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "　"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '替换非标准引号为标准引号
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """(*)"""
        .Replacement.Text = ChrW(8220) & "\1" & ChrW(8221)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '字母数字符号全角转半角 Macro
    Dim qjsz, bjsz As String, iii As Integer '定义qjsz(全角数字)、bjsz(半角数字)为字符串型，iii为整数型
        qjsz = "０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ,./<>?;’:[]{}\|=-+_)(*%$#@!`~&"
        bjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ，。／《》？；'：〔〕｛｝＼｜＝－＋＿）（×％＄＃＠！'～＆"
        Selection.WholeStory
    For iii = 1 To 95 '循环10次
    With Selection.Find
       .Text = Mid(qjsz, iii, 1) 'mid函数：返回文本字符串中从指定位置开始的特定数目的字符，每次取一个数字
       .Replacement.Text = Mid(bjsz, iii, 1) '将用于替换的相应位置的半角数字
       .Format = False '保留替换前的字符格式
       .MatchWildcards = False
       .Execute Replace:=wdReplaceAll '用半角符号替换全角符号
    End With
    Next iii
    '修改小数点错误
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "([0-9])。([0-9])"
        .Replacement.Text = "\1.\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    '设置字号
    Selection.WholeStory  '全选
    Selection.ClearFormatting  '清除全文格式
    Selection.Font.Size = 14  '设置字号为11号
    '设置行距
    Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceSingle  '设置为单倍行距
    'Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly  '设置固定行距
    'Selection.ParagraphFormat.LineSpacing = 20   '设置固定行距
    Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify  '设置文本为两端对齐
    Selection.ParagraphFormat.CharacterUnitFirstLineIndent = 2  '设置段首缩进2字符
    Selection.HomeKey unit:=wdStory  '移至文首
    Selection.EndKey unit:=wdLine, Extend:=wdExtend  '选中首行
    Selection.ClearFormatting  '清除首行格式
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter  '设置首行居中对齐
    Selection.ParagraphFormat.LineUnitBefore = 1  '设置首行段前间距0行
    Selection.ParagraphFormat.LineUnitAfter = 1  '设置首行段后间距0.5行
    Selection.Font.Name = "方正小标宋简体"  '设置首行字体为“宋体”
    Selection.Font.Size = 16  '设置首行字号为14号
    'Selection.Font.Bold = wdToggle  '设置首行字形为加粗
    Application.ScreenUpdating = True
End Sub

zhanglei1371

Sub 标准格式设置.rar (21.19 KB, 下载次数: 7)

2024-1-24 08:16 上传

点击文件名下载附件

lhteee

谢谢，也许没有表达清楚，是将文中标题加粗，不是改为黑体字。
测试了一下，不能用。但是非常感谢！

413191246se

楼主朋友，如果你想 VBA 一键公文自动排版，可以试用一下我的代码：
https://club.excelhome.net/thread-1649038-1-1.html

lhteee

谢谢，还是希望在我用的代码的基础上添加代码。

lhteee

完美解决！！！代码如下：


Sub 一级标题加粗()
    Dim myString As String
    Dim i As Integer
  
    ' 循环遍历段落
    For Each Paragraph In ActiveDocument.Paragraphs
   
    '在每次迭代中更新字符串变量
    For i = 1 To 39
               
        ' 检查段落是否包含字符串
        If InStr(Paragraph.Range.Text, Mid("一、二、三、四、五、六、七、八、九、十、十一、十二、十三、十四、十五、十六、十七、十八、十九、二十", i, 1) & "、") > 0 Then
            Paragraph.Range.Font.Bold = wdToggle
        
        On Error GoTo VeryEnd
        
        Exit For
           
        End If
        
    Next i
   
    Next Paragraph
   
VeryEnd:
End Sub

413191246se

楼主，这句代码“Paragraph.Range.Font.Bold = wdToggle”后面的最好改为“.Bold = True”

lhteee

413191246se 发表于 2024-1-26 00:56
楼主，这句代码“Paragraph.Range.Font.Bold = wdToggle”后面的最好改为“.Bold = True”

谢谢！改了。我是比葫芦画瓢，不知道为什么？还望指点！

lhteee

又编好了加粗二级标题代码（一级为“一、二”；二级为“（一）、（二）”）。代码如下：



Sub 一二级标题加粗()

    Dim j As Integer
    Dim k As Integer
   '循环遍历段落
    For Each Paragraph In ActiveDocument.Paragraphs
   '在每次迭代中更新字符串变量
    For j = 1 To 39
   '检查段落是否包含字符串
     If InStr(Paragraph.Range.Text, Mid("一、二、三、四、五、六、七、八、九、十、十一、十二、十三、十四、十五、十六、十七、十八、十九、二十", j, 1) & "、") > 0 Then
        Paragraph.Range.Font.Bold = True
        On Error GoTo VeryEnd
        Exit For
     End If
    Next j
    Next Paragraph
VeryEnd:

    For Each Paragraph In ActiveDocument.Paragraphs
    For k = 1 To 29
     If InStr(Paragraph.Range.Text, Mid("（一、（二、（三、（四、（五、（六、（七、（八、（九、（十", k, 1) & "）") > 0 Then
        Paragraph.Range.Font.Bold = True
        On Error GoTo Second
        Exit For
     End If
    Next k
    Next Paragraph
Second:

End Sub

413191246se

lhteee 发表于 2024-1-26 14:05
谢谢！改了。我是比葫芦画瓢，不知道为什么？还望指点！

楼主，“wdToggle”意思是“切换”（常规未加粗的加粗，已加粗的取消加粗），而“True”的意思是“真”（不管加粗还是未加粗的字符统统都加粗，不切换！）。