Question

我正在使用Word的以下VBA代码，该代码将文档的每个部分提取为单独的文档。

它的来源是：http://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html

在代码中，每个提取文档的文件名均基于相应部分的第一段。我们的员工希望在每个部分的第一段中运行此代码的文档中，文档标题很好，但是这些标题均为大写。

我的问题是，当VBA运行时，生成的文件名是大写的。我只需要在文件名中将每个单词的首字母大写即可。

大写的文档标题是我的雇主可以接受的格式，因此我无法更改它们。通过更改StrTxt to LCase(.Text): StrTxt= LCase(.Text)的定义，我已经能够更改原始VBA代码以使文件名全部小写。这样比较好，因为这样员工只需要将文件名中每个单词的首字母重新输入为大写。但最好在适当的情况下自动输出它。

    Sub SplitMergedDocument()
      Application.ScreenUpdating = False
      Dim i As Long, j As Long, k As Long, StrTxt As String
      Dim Rng As Range, Doc As Document, HdFt As HeaderFooter
      Const StrNoChr As String = """*./\:?|"
      j = InputBox("How many Section breaks are there per record?", "Split By Sections", 1)
      With ActiveDocument
        **'Process each Section**
        For i = 1 To .Sections.Count - 1 Step j
        With .Sections(i)
          **'Get the 1st paragraph**
          Set Rng = .Range.Paragraphs(1).Range
          With Rng
             **'Contract the range to exclude the final paragraph break**
            .MoveEnd wdCharacter, -1
            StrTxt = .Text
            For k = 1 To Len(StrNoChr)
              StrTxt = Replace(StrTxt, Mid(StrNoChr, k, 1), "_")
            Next
          End With
          **'Construct the destination file path & name**
          StrTxt = ActiveDocument.Path & Application.PathSeparator & StrTxt
          **'Get the whole Section**
          Set Rng = .Range
          With Rng
            If j > 1 Then .MoveEnd wdSection, j - 1
            **'Contract the range to exclude the Section break**
            .MoveEnd wdCharacter, -1
            **'Copy the range**
            .Copy
          End With
        End With
        **'Create the output document**
        Set Doc = Documents.Add(Template:=ActiveDocument.AttachedTemplate.FullName, Visible:=False)
      With Doc
        ' Paste contents into the output document, preserving the formatting
        .Range.PasteAndFormat (wdFormatOriginalFormatting)
        ' Delete trailing paragraph breaks & page breaks at the end
        While .Characters.Last.Previous = vbCr Or .Characters.Last.Previous = Chr(12)
          .Characters.Last.Previous = vbNullString
        Wend
        ' Replicate the headers & footers
        For Each HdFt In Rng.Sections(j).Headers
          .Sections(j).Headers(HdFt.Index).Range.FormattedText = HdFt.Range.FormattedText
        Next
        For Each HdFt In Rng.Sections(j).Footers
          .Sections(j).Footers(HdFt.Index).Range.FormattedText = HdFt.Range.FormattedText
        Next
        ' Save & close the output document
        .SaveAs FileName:=StrTxt & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        ' and/or:
        .SaveAs FileName:=StrTxt & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With
    Next
    End With
    Set Rng = Nothing: Set Doc = Nothing
    Application.ScreenUpdating = True
    End Sub

Answer 1

您可以使用：

StrConv(StrTxt,vbProperCase)

Answer 2

之后：

    For k = 1 To Len(StrNoChr)
      StrTxt = Replace(StrTxt, Mid(StrNoChr, k, 1), "_")
    Next

插入：

StrTxt = StrConv(StrTxt, vbProperCase)

PS：您发布的代码是我编写的代码...

如何使用Word VBA更改从文档第一段生成的文件名的大小写

2 个答案: