时间戳

首页 > 解决方案 > 如何使用 Word VBA 更改从文档的第一段生成的文件名的大小写

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

问题描述

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

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

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

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

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

    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

标签： vbams-word

解决方案

You can use:

StrConv(StrTxt,vbProperCase)

推荐阅读