ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 796|回复: 5

求删除空行首行缩进代码

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-7-24 16:12 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 zzpsx 于 2020-7-24 16:20 编辑

求删除空行首行缩进代码.rar (15.05 KB, 下载次数: 19)
需要一段代码:执行以后,会删除所有空行,并让每段首行缩进
One of America's biggest circuses will soonend elephants in its shows. The circus said it would stop by 2018. All itselephants will move to an animal conservation centre. They will retire there.The circus is doing this because of public protests. One hundred years ago, itwas OK for animals to perform for humans. However, not today. People areworried about animals. The circus will continue to use other animals, such ascamels, dogs, horses, lions and tigers.









Animal rights groups have always criticisedcircuses. One group, People for the Ethical Treatment of Animals, explainedthat circus elephants have a bad life. It said many elephants have painfulbones and lung diseases. It wants the elephants to retire now. Many places inthe USA have banned the use of elephants. This makes it hard for circuses to goon tour. The owners of the circus said it was hard to stop using theirelephants. They understand the public's feeling.

TA的精华主题

TA的得分主题

发表于 2020-7-25 07:15 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
里面有一行中只有一个空格,这算不算空行?

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-7-25 08:42 | 显示全部楼层
小花鹿 发表于 2020-7-25 07:15
里面有一行中只有一个空格,这算不算空行?

算,也算,谢谢提醒。

TA的精华主题

TA的得分主题

发表于 2020-7-25 09:57 | 显示全部楼层
Sub d1()
    Rem 删除段落首尾空格及制表符但不含段落首尾下划线空格
    Application.ScreenUpdating = False
    On Error Resume Next
    For Each t In ActiveDocument.Paragraphs
        For n = 1 To t.Range.Characters.Count
            If t.Range Like " *" Or t.Range Like " *" Or t.Range Like Chr(9) & "*" Or t.Range Like ChrW(160) & "*" Then
                If t.Range.Characters(t.Range.Characters.Count - 1).Font.Underline = 0 Then t.Range.Characters(1).Delete
            ElseIf t.Range Like "* " & Chr(13) Or t.Range Like "* " & Chr(13) Or t.Range Like "*" & Chr(9) & Chr(13) Or t.Range Like "*" & ChrW(160) & Chr(13) Then
                Do While t.Range.Characters(t.Range.Characters.Count - 1) = " " Or t.Range.Characters(t.Range.Characters.Count - 1) = " " Or t.Range.Characters(t.Range.Characters.Count - 1) = Chr(9) Or t.Range.Characters(t.Range.Characters.Count - 1) = ChrW(160)
                    If t.Range.Characters(t.Range.Characters.Count - 1).Font.Underline > 0 Then Exit Do
                    t.Range.Select
                    Selection.EndKey Unit:=wdLine
                    Selection.TypeBackspace
                Loop
            Else
                Exit For
            End If
        Next n
    Next
    Rem *以下为删除空段不包括表格且不删除分节符和分页符
    For Each t In ActiveDocument.Paragraphs
        If Len(t.Range) < 2 And Not t.Range Like "*" & Chr(12) & "*" And t.Range.Tables.Count = 0 Then
            t.Range.Delete
        End If
    Next
    Rem 全文首行缩进
        With ActiveDocument.Content.ParagraphFormat
        .CharacterUnitFirstLineIndent = 2
        .LeftIndent = 0
        .LeftIndent = CentimetersToPoints(0)
        .CharacterUnitLeftIndent = 0
    End With
    Application.ScreenUpdating = True
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-7-26 08:36 | 显示全部楼层
Sub xiaohualu()
    With ActiveDocument.Content.Find
        .Execute "^13{1,}", , , 1, , , , 0, , "^p", 2
    End With
    With ActiveDocument.Range.ParagraphFormat
        .CharacterUnitFirstLineIndent = 2
    End With
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-7-26 13:21 | 显示全部楼层
小花鹿 老师 好!cuanju 老师 好!我也凑个热闹:
  1. Sub test()
  2.     Dim i As Paragraph
  3.     With ActiveDocument
  4.         '真假回车符/手动换行符=>段落标记
  5.         .Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
  6.         '全选
  7.         .Select
  8.         '居中/两端对齐=>删除段落首尾空格(半角空格/全角空格/不间断空格/制表符)
  9.         CommandBars.FindControl(ID:=122).Execute
  10.         CommandBars.FindControl(ID:=123).Execute
  11.         '删除空行(循环遍历所有段落)
  12.         For Each i In .Paragraphs
  13.             If Asc(i.Range) = 13 Then i.Range.Delete
  14.         Next
  15.         '首行缩进2字符
  16.         .Content.ParagraphFormat.CharacterUnitFirstLineIndent = 2
  17.     End With
  18. End Sub
复制代码

评分

1

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-24 07:45 , Processed in 0.030055 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表