Question

我需要编辑许多文档，我在标题中有文档的“版本号”之类的版本，这些文档具有不同的版本，但都是单个整数值。这些版本需要+1，所以我需要获取数字，然后加1然后保存。

这似乎很棘手，我不确定是否可能。任何帮助将不胜感激。

例如。 旧文档 “版本2” 新编辑 “版本3”

从here中我可以找到并替换。

Answer 1

尝试：

Sub UpdateVersions()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String
Dim wdDoc As Document, wdSctn As Section, wdHdFt As HeaderFooter
strDocNm = ActiveDocument.FullName
strFolder = GetFolder: If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      For Each wdSctn In .Sections
        With wdSctn
          For Each wdHdFt In .Headers
            With wdHdFt
              If .LinkToPrevious = False Then
                With .Range
                  With .Find
                    .ClearFormatting
                    .Replacement.ClearFormatting
                    .Text = "Version [0-9]{1,}"
                    .Replacement.Text = ""
                    .Format = False
                    .Forward = True
                    .Wrap = wdFindStop
                    .MatchWildcards = True
                    .Execute
                  End With
                  Do While .Find.Found = True
                    .Text = "Version " & Split(.Text, " ")(1) + 1
                    .Collapse wdCollapseEnd
                    .Find.Execute
                  Loop
                End With
              End If
            End With
          Next
        End With
      Next
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Answer 2

这是一个快速的技巧，可以满足您的要求。

首先，请确保已在“工具”>“项目”>“参考”菜单中引用了脚本运行时。其次，我了解到您有多个文档，因此很多工作都在一个文件夹中进行。

对于这个示例，我只是假设文件夹名称是固定的。在Real Life中，您可以修改代码以选择文件夹，然后修改代码以通过子文件夹，但这是（a）快速修改和（b）超出范围。

Public Sub IncreaseVersionNumbers()

  ' Make sure that the "Microsoft Scripting Runtime" library is enabled in the Tools>Projects>References

  Dim sRootFolder As String
  Dim oFSO As Scripting.FileSystemObject
  Dim oFolder As Scripting.Folder
  Dim oFile As Scripting.File

  sRootFolder = "C:\_Documents\VersionNumberTest\"   ' You can grab this by a Folder Selection dialog box instead

  Set oFSO = New Scripting.FileSystemObject
  Set oFolder = oFSO.GetFolder(sRootFolder)
  For Each oFile In oFolder.Files
    If InStr(1, oFile.Name, ".doc", vbTextCompare) > 0 Then
      ProcessDocument (sRootFolder & oFile.Name)
    End If
  Next oFile

End Sub


Private Sub ProcessDocument(sDocument As String)

  Dim oDoc As Word.Document
  Dim oSection As Word.Section
  Dim oRange As Range
  Dim sHeaderText As String


  On Error Resume Next
  Set oDoc = Documents.Open(sDocument)

  For Each oSection In oDoc.Sections

    Set oRange = oSection.Headers(wdHeaderFooterPrimary).Range
    If Not oRange Is Nothing Then
      ProcessHeaderRange oRange
    End If

    Set oRange = oSection.Headers(wdHeaderFooterFirstPage).Range
    If Not oRange Is Nothing Then
      ProcessHeaderRange oRange
    End If

    Set oRange = oSection.Headers(wdHeaderFooterEvenPages).Range
    If Not oRange Is Nothing Then
      ProcessHeaderRange oRange
    End If

  Next oSection

  oDoc.Close wdSaveChanges

End Sub


Private Sub ProcessHeaderRange(oRange As Range)

  Dim sText As String, sNewText As String
  Dim nPosn As Long, nStart As Long, nEnd As Long
  Dim sVersion As String, nVersion As Long


  sText = oRange.Text & " "

  nPosn = InStr(1, sText, "Version", vbTextCompare)
  If nPosn > 0 Then
    nStart = InStr(nPosn, sText, " ")
    If nStart > 0 Then
      nStart = nStart + 1
      nEnd = InStr(nStart, sText, " ")
      If nEnd > 0 Then
        sVersion = Mid$(sText, nStart, nEnd - nStart)
        nVersion = Val(sVersion)
        nVersion = nVersion + 1

        sNewText = Left$(sText, nStart - 1) & Trim$(Str$(nVersion)) & " " & Right$(sText, Len(sText) - nEnd)
        sNewText = Left$(sNewText, Len(sNewText) - 1)
        oRange.Text = sNewText
      End If
    End If
  End If

End Sub

正如我所说，这是一个快速的技巧，因此它可能无法完美运行，但是像往常一样具有备份！

这可以通过遍历文档每个可能部分中的三个可能的标头来实现。而且，如果它在某节中找到标题，那么它就会按照您说的做。

此版本确实超过了一位数字版本号。但是，正如我所说，这是一个快速的技巧，因此需要额外的工作才能使其真正具有防弹性能。话虽如此，我认为这是一个合理的开始。

希望这会有所帮助，

Malc

使用VBA进行简单的文字计算

2 个答案: