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

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)

附言:你发布的代码是我写的代码…