0
J'ai un script qui s'exécute correctement si je l'initie à partir de l'éditeur VBA, mais pas lorsque je l'initie à partir de Word.Supprimer la mise en évidence d'une sélection
Le script définit des acronymes dans les documents Word. Avant que le fichier Word ne me parvienne, il passe par une édition de premier niveau dans laquelle l'éditeur met en évidence les termes vérifiés. Parce que mon script utilise également la mise en évidence, je l'ai remplacer la mise en évidence existante avec du texte coloré. Lorsque j'exécute le script à partir de Word, il ignore ce bloc de code entier. Lorsque j'apporte d'autres modifications (par exemple, je viens de mettre à jour l'une des formes appelées par la macro pour ajouter une explication au texte vert), elles arrivent, peu importe d'où je commence le script.
Ci-dessous le script complet.
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
Je recommanderais de spécifier la plage au lieu d'utiliser la sélection. Par exemple 'ActiveDocument.Range' au lieu de' Selection' – Slai