0
VBAエディタから起動すると正しく動作するスクリプトがありますが、Wordから起動するときはスクリプトがありません。選択範囲からハイライト表示を削除する
このスクリプトでは、Word文書に頭字語を定義しています。 Wordファイルが私に届く前に、エディタが検証された用語を強調表示する第1レベルの編集を行います。私のスクリプトも強調表示を使用しているので、私は既存の強調表示を色付きテキストに置き換えました。
'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からスクリプトを実行すると、そのコードブロック全体がスキップされます。
他の変更（たとえば、マクロが緑色のテキストの説明を追加するために呼び出すフォームのうちの1つを更新した場合など）は、どこからスクリプトを開始していても表示されます。
以下はスクリプト全体です。
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
選択を使用する代わりに範囲を指定することをお勧めします。たとえば、 'Selection'ではなく' ActiveDocument.Range'です。 – Slai