2017-08-04 94 views
0

我有一個腳本,如果我從VBA編輯器啓動它,但是從Word啓動它時沒有正確運行。刪除選中的突出顯示

該腳本在Word文檔中定義首字母縮略詞。在Word文件出現之前,它會經過第一級編輯,編輯器會突出顯示已驗證的術語。因爲我的腳本也使用突出顯示,所以我用它替換了現有的帶有彩色文本的突出顯示。

'Turn track changes off, replace yellow highlighting from FLEs with colored text to avoid confusion between 
'FLE highlighting and acronym defininer highlighting 
ActiveDocument.TrackRevisions = False 
Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 

With Selection.Find 

    .Highlight = True 

    With .Replacement 

     .Highlight = False 
     .Font.Color = RGB(155, 187, 89) 

    End With 

    .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop 

End With 

Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 

當我從Word運行腳本時,它會跳過整個代碼塊。

當我進行其他更改(例如,我剛剛更新了宏調用的一個表單以添加綠色文本的解釋)時,無論從哪裏啓動腳本,它們都會通過。

下面是整個腳本。

Option Explicit 
Public Definitions(5) As String 

Sub Acronym_Definer() 
'Defines Workbook and Worksheet, Opens Excel 
Dim xlApp As Excel.Application 
Dim xlWbk As Workbook 
Dim FN As String: FN = "C:\Users\" & Environ$("Username") & "\AppData\Roaming\Gartner\AcronymDefiner\AcronymDefiner.xlsx" 

Dim Current_Row As Long: Current_Row = 2 

Set xlApp = New Excel.Application 
xlApp.Visible = False 
Set xlWbk = xlApp.Workbooks.Open(FN) 

'Determines whether Track Changes is on or off so it can be returned to original state at end of macro 
Dim Track_Changes As Boolean 
If ActiveDocument.TrackRevisions = False Then 

    Track_Changes = False 

End If 

'Changes to Simple View in Track Changes to keep deleted text from coming up in searches throughout the macro 
With ActiveWindow.View.RevisionsFilter 
    .Markup = wdRevisionsMarkupSimple 
    .View = wdRevisionsViewFinal 
End With 

'Turn track changes off, replace yellow highlighting from FLEs with colored text to avoid confusion between 
'FLE highlighting and acronym defininer highlighting 
ActiveDocument.TrackRevisions = False 
Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 

With Selection.Find 

    .Highlight = True 

    With .Replacement 

     .Highlight = False 
     .Font.Color = RGB(155, 187, 89) 

    End With 

    .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop 

End With 

Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 

'Begins acronym definition loop 
Do While Current_Row <= xlWbk.ActiveSheet.UsedRange.Rows.Count 

    'Use to decide which column to check for NNTD status 
    Dim NNTD_Column As Integer 
    Dim NNTD As Boolean: NNTD = False 

    Dim Chosen_Definition As String 
    Dim Current_Acronym As String: Current_Acronym = xlWbk.ActiveSheet.Cells(Current_Row, 1) 
    Dim User_Skip As Boolean 

    Selection.HomeKey unit:=wdStory 

    With Selection.Find 

     .ClearFormatting 
     '.Font.Color = wdColorAutomatic 
     .Text = Current_Acronym 
     .MatchCase = True 
     .MatchWholeWord = True 
     .Wrap = wdFindStop 

    End With 

    'Check for presence of acronym 
    If Selection.Find.Execute Then 

     'How many definitions does this acronym have? 
     Dim Number_Definitions As Integer: Number_Definitions = xlWbk.ActiveSheet.Cells(Current_Row, 2) 

     'There's only one definition; the definition is in column 3 and the NNTD status is in column 4 
     If Number_Definitions = 1 Then 

      Chosen_Definition = xlWbk.ActiveSheet.Cells(Current_Row, 3) 
      NNTD_Column = 4 
      NNTD = xlWbk.ActiveSheet.Cells(Current_Row, NNTD_Column) 
      User_Skip = False 

     'There's more than one definition; put definitions into array and get definition from user form 
     Else 

      'Ensures Array is empty at start of each loop 
      Erase Definitions 

      'Adds the definitions to Definitions array 
      Dim i As Integer 
      Dim Current_Column As Integer: Current_Column = 3 

      For i = 1 To Number_Definitions 

       Definitions(i - 1) = xlWbk.ActiveSheet.Cells(Current_Row, Current_Column) 
       Current_Column = Current_Column + 2 

      Next i 

      'Opens userform to allow user to choose from the available definitions 
      Load DefinitionList 
      DefinitionList.lstAvailableDefinitions.List = Definitions 
      DefinitionList.Show 

      'Did the user select an option? 
      If IsNull(DefinitionList.lstAvailableDefinitions.Value) Then 

       User_Skip = True 

      Else 

       'Assigns user selection to Chosen_Definition variable 
       Chosen_Definition = DefinitionList.lstAvailableDefinitions.Value 

       User_Skip = False 

       'Determines NNTD column 
       Dim j As Integer 
       For j = LBound(Definitions) To UBound(Definitions) 

        If Definitions(j) = Chosen_Definition Then 
        NNTD_Column = (2 * j) + 4 
        Exit For 
        End If 

       Next j 

       Unload DefinitionList 

      NNTD = xlWbk.ActiveSheet.Cells(Current_Row, NNTD_Column) 

      End If 

     End If 

     'Acronym is NNTD 
     If NNTD = True Then 

      'Highlights NNTD acronyms in yellow. 
      Options.DefaultHighlightColorIndex = wdYellow 
      Selection.HomeKey unit:=wdStory 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Current_Acronym 
       .MatchCase = True 
       .MatchWholeWord = True 

       With .Replacement 

        .Highlight = True 
        .Text = "" 

       End With 

       .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop 

      End With 

     'User chose to skip or clicked OK without selecting an option; highlight all instances of acronym in red 
     ElseIf User_Skip = True Then 

      Unload DefinitionList 

      Options.DefaultHighlightColorIndex = wdRed 
      Selection.HomeKey unit:=wdStory 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Current_Acronym 
       .MatchCase = True 
       .MatchWholeWord = True 

       With .Replacement 

        .Highlight = True 
        .Text = "" 

       End With 

       .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop 

      End With 

     'Acronym needs to be defined 
     Else 

      'Selects first instance of acronym. Get start position of first instance of acronym. 
      Selection.HomeKey unit:=wdStory 
      Selection.Find.Execute Current_Acronym 
      Dim AcronymStart As Long: AcronymStart = Selection.Start 

      'Determines whether definition occurs in document 
      Selection.HomeKey unit:=wdStory 
      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Chosen_Definition 
       .MatchCase = False 
       .Execute Wrap:=wdFindStop 

      End With 

      'Definition doesn't occur; insert definition before first definition of acronym and add 
      'parentheses around acronym 
      If Selection.Find.Found = False Then 

       Selection.HomeKey unit:=wdStory 

       With Selection.Find 

        '.Font.Color = wdColorAutomatic 
        .Text = Current_Acronym 
        .MatchCase = True 
        .Execute 

       End With 

       With Selection 

        .InsertBefore Chosen_Definition & " (" 
        .InsertAfter ")" 

       End With 

      'Definition occurs in document; get end position of definition and compare to start position of acronym 
      '(should be two lower than acronym) 
      Else 

       Selection.HomeKey unit:=wdStory 
       Selection.Find.Execute Chosen_Definition 
       Dim DefinitionEnd As Long: DefinitionEnd = Selection.End 

       'Acronym is correctly defined; no further action is needed to define the acronym 
       If DefinitionEnd = AcronymStart - 2 Then 

       'Definition occurs after acronym; insert definition before first instance of acronym 
       ElseIf DefinitionEnd > AcronymStart Then 

        'Moves to first instance of acronym 
        Selection.HomeKey unit:=wdStory 

        'Adds definition and places parentheses around acronym 
        With Selection.Find 

         '.Font.Color = wdColorAutomatic 
         .Text = Current_Acronym 
         .MatchCase = True 
         .Execute 

        End With 

        With Selection 

         .InsertBefore Chosen_Definition & " (" 
         .InsertAfter ")" 

        End With 

       'Definition occurs before (but not immediately prior to) acronym 
       Else 

        Selection.HomeKey unit:=wdStory 
        Selection.Find.Execute Chosen_Definition 

        'Inserts acronym (surrounded by parentheses) after definition 
        With Selection 

         .InsertAfter " (" & Current_Acronym & ")" 

        End With 

       End If 

      End If 

      'Replace subsequent instances of acronym *and* definition with just acronym 
      Dim Defined_Acronym As String: Defined_Acronym = Chosen_Definition & " (" & Current_Acronym & ")" 

      'Moves cursor to follow first instance of Defined_Acronym 
      Selection.HomeKey unit:=wdStory 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Defined_Acronym 
       .MatchCase = False 
       .Execute 

      End With 

      'Performs actual replacement of all but first instance of Defined_Acronym with acronym. 
      Selection.HomeKey unit:=wdStory 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Defined_Acronym 
       .MatchCase = False 
       .Execute 

      End With 

      Selection.EndOf unit:=wdWord, Extend:=wdMove 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Defined_Acronym 
       .MatchCase = False 

       With .Replacement 

        .Highlight = False 
        .Text = Current_Acronym 

       End With 

       .Execute Wrap:=wdFindStop, Replace:=wdReplaceAll 

      End With 


      'Replace subsequent instances of definition (by itself) with acronym 
      'Moves cursor to follow first instance of Defined_Acronym 
      Selection.HomeKey unit:=wdStory 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Defined_Acronym 
       .MatchCase = False 
       .Execute 

      End With 

      Selection.EndOf unit:=wdWord, Extend:=wdMove 

      With Selection.Find 

       '.Font.Color = wdColorAutomatic 
       .Text = Chosen_Definition 
       .MatchCase = False 


       With .Replacement 

        .ClearFormatting 
        .Text = Current_Acronym 

       End With 

       .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop 

      End With 

      'Set highlight color to teal for non-NNTD acronyms, highlight all instances of Current_Acronym 
      Options.DefaultHighlightColorIndex = wdTeal 
      Selection.HomeKey unit:=wdStory 

      With Selection.Find 

       .ClearFormatting 
       '.Font.Color = wdColorAutomatic 
       .Text = Current_Acronym 
       .MatchCase = True 
       .MatchWholeWord = True 

       With .Replacement 

        .Highlight = True 
        .Text = "" 

       End With 

       .Execute Replace:=wdReplaceAll, Wrap:=wdFindStop 

      End With 

     End If 

    End If 

    'Ends acronym definition loop 
    Current_Row = Current_Row + 1 

Loop 

'Returns track changes to same status it was in when script began 
If Track_Changes = False Then 

    ActiveDocument.TrackRevisions = False 

End If 

'Returns view to show all track changes 
With ActiveWindow.View.RevisionsFilter 
    .Markup = wdRevisionsMarkupAll 
    .View = wdRevisionsViewFinal 
End With 

Load Instructions 
Instructions.Show 

Selection.Find.ClearFormatting 
Selection.Find.Replacement.ClearFormatting 

'Closes Excel 
xlWbk.Close SaveChanges:=False 
xlApp.Quit 

End Sub 

Function Define_Acronym() 

End Function 
+1

我會建議指定範圍,而不是使用選擇。例如'ActiveDocument.Range'而不是'Selection' – Slai

回答

1

根據您如何調用宏,起初選擇可能不存在。請記住,Selection.Find本質上的意思是「在當前選擇指定的範圍內查找[無論]」。看到你將這個選項摺疊到無效Selection.Homekey Unit:=WdStory我試圖找出你的代碼爲什麼工作並失敗。由於某些原因,Word本身似乎同意在選擇爲0(或1)時搜索整個文檔。但零與Nothing不一樣。

更好的方法是指定您希望搜索的範圍或選擇。無論哪種方式,它應該是ActiveDocument.Content,如果你想搜索整個文檔的主體。雖然您的代碼基於使用Selection對象,但您必須進行此類選擇,例如ActiveDocument.Content.Select

@Slai和我建議不要使用Selection對象。改用Range對象。閱讀有關差異at MSDN

+0

謝謝你的迴應。下一次我有機會研究這個問題時,我會看到關於切換的事情。由於我非常使用selection.homekey,所以我不得不重構一些。我會在那個時候更新。 –

相關問題