如何只保留首字母

zzpsx

如何用代码，只保留下划线单词的首字母.rar (13.56 KB, 下载次数: 7)

2020-7-2 21:25 上传

点击文件名下载附件

jiangxiaoyun

Sub findstr()
    Dim str$, i%
    With ActiveDocument.Content.Find
        .Font.Underline = wdUnderlineSingle
        Do While .Execute(FindText:="", Format:=True)
            i = i + 1
            sr = .Parent
          .Parent = Left(sr, 1) & Space(Len(sr) - 1)
        Loop
    End With
End Sub

413191246se

1. Sub test()
   
2.     With ActiveDocument.Content.Find
   
3.         .ClearFormatting
   
4.         .Text = ""
   
5.         .Font.Underline = wdUnderlineSingle
   
6.         .Forward = True
   
7.         .MatchWildcards = True
   
8.         Do While .Execute
   
9.             With .Parent
   
10.                 .Text = Left(.Text, 1) & Space(Len(.Text) - 1)
    
11.             End With
    
12.         Loop
    
13.     End With
    
14. End Sub
    

复制代码

zzpsx

谢谢各位的好代码，如果能把下划线的长度统一就更好了。

ggmmlol

zzpsx 发表于 2020-7-3 15:24
谢谢各位的好代码，如果能把下划线的长度统一就更好了。

Sub 替换为下划线()
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        With .Font
            .Underline = wdUnderlineSingle
            .Color = wdColorRed
        End With
        .Text = "<([a-zA-Z])[a-zA-Z]*>"
        .Replacement.Text = "\1         "
        .Forward = True
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub

413191246se

楼主，请将第10行语句的“Len(.Text) - 1”替换为 8 试试。