【已解决】自动延长WORD下画线，与最长的下划线一样，或者统一下划线长度

LMY123

LMY123.rar (40.17 KB, 下载次数: 3)

2018-3-23 10:58 上传

点击文件名下载附件

LMY123

Sub 批量运行宏()

  Dim mydialog As FileDialog, i As Integer, sFile As String

  ' On Error Resume Next '忽略错误

  '定义一个文件选取对话框
  Set mydialog = Application.FileDialog(msoFileDialogFilePicker)
  With mydialog
  .Filters.Clear '清除所有文件筛选器中的项目
  .Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
  .AllowMultiSelect = True '允许多项选择
  .Show
  If .SelectedItems.Count = 0 Then
    MsgBox "没有选择任何文件！", vbExclamation + vbOKOnly, "提示"
    Exit Sub
  End If
  
  For i = 1 To .SelectedItems.Count
    sFile = .SelectedItems(i)
    Documents.Open FileName:=sFile
    Call 页面设置程序
    ActiveDocument.Close True
  Next

  MsgBox "文件处理完毕！" & vbCrLf & vbCrLf & "共处理了 " & .SelectedItems.Count & " 个文件", vbInformation + vbOKOnly, "提示"
  End With

End Sub
Sub 页面设置程序()
Dim myRange As Range, oPar As Paragraph
Set myRange = IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
Application.ScreenUpdating = False
For Each oPar In myRange.Paragraphs
    With oPar
        If InStr(.Range, "卷") > 0 Or InStr(.Range, "起") > 0 Then
            .TabStops.Add .Range.PageSetup.TextColumns.Width, Leader:=wdTabLeaderLines
            ActiveDocument.Range(.Range.End - 1, .Range.End - 1).InsertBefore vbTab
        End If
    End With
Next
Application.ScreenUpdating = True
End Sub

orc250

学习了学习了学习了学习了学习了学习了学习了