Question

我需要使用智能引号创建的现有word文件，我必须打开每个文档并替换引号，然后保存并关闭。我编写了宏，使用单词上的录音机功能完美地工作。

现在我已经看到人们编写的宏可以在文件夹中的每个文件的循环中运行宏，但我不知道我从哪里实际运行该宏。

Sub Macro1()
'
' Macro1 Macro
'
'
    ActiveDocument.Convert
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """"
        .Replacement.Text = """"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "'"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ChangeFileOpenDirectory _
        "\\EXPRESS-SERVER\MTMQuote\Quote Archive\Quote Archive (Out Dated)\Expert Quotes\120001-130000 (2013-)\125001-126000 (2015)\Updated\"
    ActiveDocument.SaveAs2 FileName:= _
        (ActiveDocument.Name) _
        , FileFormat:=wdFormatDocumentDefault, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
    ActiveDocument.Close
    Application.Quit
End Sub

如何反复运行？我桌面上的文件夹中有大约1000个文件，名为＆＃34; MTMUPDATES＆＃34;

Answer 1

使用此：

（但不要将它们命名为同一个东西，不管你用什么来命名文档的数量或其他东西）

Sub replacer()
   Dim MyDialog As FileDialog, GetStr(1 To 1000) As String '1000 files is the maximum applying this code

   On Error Resume Next

   Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
   With MyDialog
    .Filters.Clear
    .Filters.Add "All WORD File ", "*.*", 1
    .AllowMultiSelect = True
      i = 1
      If .Show = -1 Then
         For Each stiSelectedItem In .SelectedItems
           GetStr(i) = stiSelectedItem
           i = i + 1
         Next
         i = i - 1
      End If

      Application.ScreenUpdating = False

      For j = 1 To i Step 1
        Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
        Windows(GetStr(j)).Activate
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting

        With Selection.Find
         .Text = "'" 'find what
         .Replacement.Text = "'" 'replace with
         .Forward = True
         .Wrap = wdFindAsk
         .Format = False
         .MatchCase = False
         .MatchWholeWord = False
         .MatchByte = True
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Application.Run macroname:="NEWMACROS"

        docname = InputBox("Enter file name", "docname") 'replace this with some sort of naming device or use the next thing
        newname = docname & ".doc"
        ActiveDocument.SaveAs FileName:=newname

        'ActiveDocument.Save 'use this if you just want to save the document. remove the apostrophe before and delete the previous little expression or put apostrophes in front of it

        ActiveWindow.Close
      Next
      Application.ScreenUpdating = True
   End With
   MsgBox "operation end, please view", vbInformation

End Sub

我不确定如何正确运行此宏

1 个答案: