2015-06-25 29 views
-1

我需要採用用智能引號創建的現有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個文件被稱爲「MTMUPDATES」

回答

0

使用此:

(但不要他們的名字都是一樣的東西,讓不管你用它來命名文檔計數或某事)

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 
相關問題