Office VBA Macros You Can Use Today phần 4 pot

Word Procedures Office VBA: Macros You Can Use Today page 121 Wrd Figure 45 – Naming and Storing a Macro in Word 5. Once you click OK in the Customize dialog box, the macro recording begins. Go to Format | Bullets and Numbering and follow the steps required to create the preferred numbering format. 6. When you have finished making the settings and dismissed the Bullets and Numbering dialog box, stop the macro recorder by clicking the Stop button on the Stop recording toolbar, by double-clicking the REC button on the status bar, or by using the Tools | Macro | Stop Recording command. 7. Test the macro by selecting some paragraphs, then clicking on the new button. Tip: If you make a mistake, simply start over. The macro recorder will overwrite the first macro if you give it the same name. In order to view the macro, open the New Macros module in the project where the macro was created. View the Appendix to learn how to open the VBE and locate the NewMacros module. The macro recorder generates code for formatting all nine outline numbering levels, even if changes are only made to the settings for a few of the top levels. Word Procedures page 122 Office VBA: Macros You Can Use Today Wrd Finding and Replacing in Multiple Documents This procedure demonstrates how to use common Office dialogs and how to loop Find through all parts of a document. Example file: W002_1.doc and W002_2.doc This macro combines these two tasks. It loops through all Word files in the folder selected from the dialog box, opens each one in turn, searches for fields that link to outside files, and changes the file path. This approach can be adapted to find other things, such as the need to replace a company logo or to take a desired action. View the Appendix to learn how to store this procedure in a Standard module. Option explicit¶ ' * * * * *¶ 'Finds a field code¶ Const FindText = "^d"¶ ' * * * * *¶ Sub ChangeLinks()¶ 'Variable declaration¶ Dim FilePath As String¶ Dim linkPath As String¶ Dim securitySetting As Long¶ FilePath = GetFileFolder("Select folder to process")¶ 'User cancelled¶ If Len(FilePath) = 0 Then Exit Sub¶ linkPath = GetFileFolder("Select path to linked file")¶ 'User cancelled¶ If Len(linkPath) = 0 Then Exit Sub¶ Scenario: The macro recorder is useful, but when the result is played back, the behavior does not always correspond to what happens in the user interface. One excellent example of this is recording Edit | Find or Edit | Replace. In the user interface, Find and Replace processes the entire document, including headers, footers, footnotes and drawing objects. It is rather a nasty surprise to find out that the recorded macro only works in the current "document story"; that is, the main body OR the header, OR the footer, OR the drawing objects. The macro recorder also cannot record looping through and processing all the files in a selected folder. Word Procedures Office VBA: Macros You Can Use Today page 123 Wrd 'Debug.Print FilePath, LinkPath¶ 'Suppress screen flicker as much as possible¶ Application.ScreenUpdating = False¶ 'Save the user's current macro security setting¶ securitySetting = Application.AutomationSecurity¶ 'Suppress macro warnings¶ Application.AutomationSecurity = msoAutomationSecurityLow¶ 'Suppress messages, as far as possible¶ Application.DisplayAlerts = wdAlertsNone¶ 'Don't allow Automacros to run¶ WordBasic.DisableAutoMacros¶ ProcessFiles FilePath, linkPath¶ 'Restore original settings¶ WordBasic.DisableAutoMacros 0¶ Application.DisplayAlerts = wdAlertsAll¶ Application.AutomationSecurity = securitySetting¶ End Sub¶ ' * * * * *¶ Function GetFileFolder(DlgTitle As String) As String¶ 'Variable declaration¶ Dim dlg As Office.FileDialog¶ 'Use the Office FileDialog box to get the path info¶ Set dlg = Application.FileDialog(msoFileDialogFolderPicker)¶ With dlg¶ .AllowMultiSelect = False¶ .ButtonName = "Select Folder"¶ .InitialView = msoFileDialogViewList¶ .Title = DlgTitle¶ 'User did not cancel¶ If .Show = -1 Then¶ GetFileFolder = .SelectedItems.Item(1)¶ End If¶ End With¶ End Function¶ ' * * * * *¶ Sub ProcessFiles(FilePath As String, linkPath As String)¶ 'Variable declaration¶ Dim doc As Word.Document¶ ' !Remember to reference Microsoft Scripting Runtime!¶ Dim fso As Scripting.FileSystemObject¶ Dim f As Scripting.Folder, fil As Scripting.File¶ Set fso = CreateObject("Scripting.FileSystemObject")¶ 'If the folder exists ¶ If fso.FolderExists(FilePath) Then¶ Set f = fso.GetFolder(FilePath)¶ 'Loop through each file in it¶ For Each fil In f.Files¶ 'Check if it's a Word document¶ If LCase(fil.Type) = "microsoft word document" Then¶ 'If yes, open it¶ Set doc = Documents.Open(fil.Path)¶ Word Procedures page 124 Office VBA: Macros You Can Use Today Wrd ProcessDoc doc, linkPath¶ 'If changes were made, document was saved¶ 'before, so don't save again¶ doc.Close SaveChanges:=wdDoNotSaveChanges¶ Set doc = Nothing¶ End If¶ Next fil¶ Else¶ 'folder not found. Unlikely, since was picked¶ 'from folder dialog.¶ End If¶ Set fso = Nothing¶ End Sub¶ ' * * * * *¶ Sub ProcessDoc(ByRef doc As Word.Document, linkPath As String)¶ 'Variable declaration¶ Dim rng As Word.Range¶ 'Loop through all parts of a document¶ For Each rng In doc.StoryRanges¶ 'If appropriate field codes were found,¶ 'save the document¶ If DoFind(rng, linkPath) Then doc.Save¶ Do Until rng.NextStoryRange Is Nothing¶ If DoFind(rng, linkPath) Then doc.Save¶ Loop¶ Next¶ End Sub¶ ' * * * * *¶ Function DoFind(rng As Word.Range, linkPath As String) As Boolean¶ 'Variable declaration¶ Dim bFound As Boolean¶ Dim fieldCode As String¶ Dim origRng As Word.Range¶ 'Determine where the original range first ended¶ ' after a successful Find because the range being searched¶ 'changes to the found range¶ Set origRng = rng.Duplicate¶ Do¶ 'Make sure field codes are recognized¶ 'Else the macro won't find ^d¶ rng.TextRetrievalMode.IncludeFieldCodes = True¶ With rng.Find¶ .ClearFormatting¶ .Forward = True¶ .MatchCase = False¶ .MatchWholeWord = False¶ .MatchWildcards = False¶ .Text = FindText¶ bFound = .Execute¶ If bFound Then¶ fieldCode = rng.Text¶ Word Procedures Office VBA: Macros You Can Use Today page 125 Wrd 'Check whether it's a field that links¶ 'in an outside file¶ If InStr(LCase(fieldCode), "includetext") <> 0 _¶ Or InStr(LCase(fieldCode), "includepicture") <> 0 _¶ Or InStr(LCase(fieldCode), "link") <> 0 Then¶ 'If it is, replace the old path with the new¶ rng.Fields(1).Code.Text = NewFieldCode(fieldCode, linkPath)¶ rng.Fields(1).Update¶ DoFind = True¶ End If¶ End If¶ End With¶ 'Extend the search range again to¶ 'the end of the original range¶ rng.Collapse wdCollapseEnd¶ rng.End = origRng.End¶ Loop While bFound¶ End Function¶ ' * * * * *¶ Function NewFieldCode(ByRef fieldCode As String, linkPath As String) As String¶ 'Variable declaration¶ Dim startPos As Long, endPos As Long¶ Dim newCode As String, docName As String¶ 'Find where the first space after the field name is¶ startPos = InStr(3, fieldCode, " ")¶ 'If the file path contains spaces, it will¶ 'be enclosed in "quotes"¶ 'Get the position at the end of the path¶ 'either the closing quote, or the first space¶ If Mid(fieldCode, startPos + 1, 1) = Chr$(34) Then¶ endPos = InStr(startPos + 2, fieldCode, Chr$(34)) + 1¶ Else¶ endPos = InStr(startPos + 2, fieldCode, " ")¶ End If¶ 'doc name is from the end of the path to¶ 'the first backslash¶ docName = Mid(fieldCode, _¶ InStrRev(fieldCode, "\", endPos) + 1, _¶ endPos - InStrRev(fieldCode, "\", endPos) - 2)¶ 'Now put all the parts back together, with the¶ 'new link path¶ newCode = Mid(fieldCode, 2, startPos - 1) & _¶ Chr$(34) & linkPath & "\" & docName & Chr$(34) & _¶ Mid(fieldCode, endPos, Len(fieldCode) - endPos)¶ 'Fieldcodes in Word need double backslashes¶ newCode = DoubleBackslashes(newCode)¶ NewFieldCode = newCode¶ End Function¶ Word Procedures page 126 Office VBA: Macros You Can Use Today Wrd ' * * * * *¶ Function DoubleBackslashes(s As String) As String¶ 'Variable declaration¶ Dim newString As String, startPos As Long, endPos As Long¶ startPos = 1¶ 'Locate each backslash and insert an additional one¶ Do While InStr(startPos, s, "\") <> 0¶ endPos = InStr(startPos, s, "\")¶ newString = newString & Mid(s, startPos, endPos - startPos + 1) & "\"¶ startPos = endPos + 1¶ Loop¶ newString = newString & Mid(s, startPos)¶ DoubleBackslashes = newString¶ End Function¶ This tool is built modularly so that it can be adapted to various requirements fairly easily. For example, to do a regular Find and Replace, record a macro for the search to use, then substitute the recorded code for the code in the procedure DoFind. This macro changes the path of linked objects that are formatted in-line with the text only (no text wrap formatting is applied). To combine this macro with text wrap, insert the linked object into a FRAME (from the Forms toolbar). Highlighting a Selection With this procedure, you can apply highlighting to selected text or highlight an entire word at the insertion point if there is no selection. Example file: W003 View the Appendix to learn how to store this procedure in a Standard module. Scenario: Highlighting is a very useful functionality, but selecting text, moving to the toolbar button, then selecting the color quickly becomes a tedious task. Instead, it would be useful to simply hit a keyboard combination in order to apply highlighting; and, if no text is selected, to automatically apply it to the word in which the insertion point is currently blinking. Word Procedures Office VBA: Macros You Can Use Today page 127 Wrd Option explicit¶ ' * * * * *¶ Private Const highlightColor As Long = wdBrightGreen¶ 'Alternate values: wdPink, wdYellow, wdTurquoise¶ ' wdGreen, wdBlue, wdRed, wdTeal, wdDarkRed, wdDarkYellow¶ ' wdDarkBlue, wdGray25, wdGray50, wdViolet, wdBlack¶ ' * * * * *¶ Sub HighlightSelection()¶ 'Check if the selection is only an insertion point (IP)¶ 'If it is, extend the range to include the entire word¶ 'at the IP, or the one to which it is directly adjacent¶ If Selection.Type = wdSelectionIP Then¶ 'Comment out the following line if retaining¶ 'a bracket only, and not highlighting an entire word¶ 'is desired if there is no selection¶ Selection.Words(1).Select¶ End If¶ Selection.Range.HighlightColorIndex = highlightColor¶ End Sub¶ Tip: If you prefer a different highlight color, substitute one of the alternate values for wdBrightGreen, such as wdRed or wdViolet. This macro should be assigned to a keyboard shortcut. The example file has the macro assigned to Alt+H. Highlighting a Selection in Word 2002/XP The basis of HighlightSelection may be of interest to Word 2002 users. Word 2002—in contrast to earlier and later versions—does not apply highlighting to commented text. The selected text is surrounded by very thin brackets, which are often hard to see. If no text is selected, there is simply a bar marking the place in the text, which makes it not only difficult to find, but also almost impossible to position the mouse pointer to display the comment in a tool tip. The following macro, InsertAnnotation, calls HighlightSelection to help create visible comments in Word 2002 documents. View the Appendix to learn how to store this procedure in a Standard module. Word Procedures page 128 Office VBA: Macros You Can Use Today Wrd Option explicit¶ ' * * * * *¶ Sub InsertAnnotation()¶ 'Variable declaration¶ Dim rng As Word.Range¶ Dim cmt As Word.Comment¶ 'Optional: prompt to enter the comment text¶ 'Comment out the following 7 lines of code¶ 'if you do not want to be prompted¶ Dim commentText As String¶ Dim msgPrompt As String¶ Dim msgTitle As String¶ commentText = ""¶ 'Change the text in "quotes" to change the prompt¶ msgPrompt = "Enter the comment text"¶ 'Change the text in "quotes" to change¶ 'the title at the top of the box¶ msgTitle = "Comment text"¶ commentText = InputBox(msgPrompt, msgTitle)¶ If commentText = "" Then Exit Sub¶ 'Set the highlight¶ HighlightSelection¶ Set rng = Selection.Range¶ 'Create the comment¶ Set cmt = ActiveDocument.Comments.Add(rng, commentText)¶ 'Optional: Display the Reviewing task pane¶ 'Comment out the following 6 code lines if¶ 'forcing display of the task pane is not desired.¶ 'If there's more than one task pane, check if the second one¶ 'is in Web View; if not, set the Revisions task pane¶ If ActiveWindow.Panes.Count > 1 Then¶ If ActiveDocument.ActiveWindow.Panes(2).View <> wdWebView _¶ Then _¶ ActiveWindow.View.SplitSpecial = wdPaneComments¶ Else¶ 'if there's only one pane for the document¶ 'display the Revisions task pane¶ ActiveWindow.View.SplitSpecial = wdPaneComments¶ End If¶ End Sub¶ Word Procedures Office VBA: Macros You Can Use Today page 129 Wrd Removing All Highlighting This procedure removes all highlighting in a document or part of a document. Example file: W004 Tip: If you make a mistake and run the macro unintentionally, don't panic! Simply use Edit/Undo and the highlighting will be restored. View the Appendix to learn how to store this procedure in a Standard module. Option Explicit¶ ' * * * * *¶ Sub RemoveHighlighting()¶ If Selection.Type = wdSelectionIP Then¶ ActiveDocument.Range.HighlightColorIndex _¶ = wdNoHighlight¶ ElseIf Selection.Type = wdSelectionNormal Then¶ Selection.Range.HighlightColorIndex _¶ = wdNoHighlight¶ Else¶ MsgBox "No text is selected."¶ End If¶ End Sub¶ Scenario: A technique used in working with Word documents is highlighting to make something visible while working in a document. This method is proposed in some of the macros in this book. At some point, you’ll want to remove the highlighting that you applied. Word Procedures page 130 Office VBA: Macros You Can Use Today Wrd Inserting AutoText with No Formatting This procedure lets you insert an AutoText entry as plain text. Example file: W005 View the Appendix to learn how to store this procedure in a Standard module. Option explicit¶ ' * * * * *¶ Sub InsertAutoTextNoFormatting()¶ 'Variable declaration¶ Dim tmpl As Word.Template¶ With Dialogs(wdDialogEditAutoText)¶ .Display¶ 'Because "Display" is used, the macro¶ 'takes care of the actual insertion.¶ 'But only if the user chose the Insert button¶ If .Insert = -1 Then¶ 'Loop through all loaded templates¶ For Each tmpl In Application.Templates¶ 'Continue when error occurs¶ On Error Resume Next¶ tmpl.AutoTextEntries(.Name).Insert _¶ Where:=Selection.Range, RichText:=False¶ 'If the AutoText name is not found in a¶ 'template, an error is generated.¶ 'Rather than displaying an error message,¶ 'the error code is checked. If it's 0, then¶ 'there was no error and the AutoText entry was¶ 'inserted successfully. The macro can end¶ Scenario: Prior to Word 97, there was a checkbox in the AutoText dialog box that let the user choose whether an AutoText entry should be inserted with its formatting or as "plain text", so that it would adapt to the formatting of the text at the insertion point. Although this functionality has since been lost to the user interface, it is still available through a macro. This macro displays the built-in Insert | AutoText | AutoText dialog box so that the user can select from the entire range of AutoText entries. The dialog box does not execute, however. Instead, the macro takes care of inserting the AutoText, without any accompanying formatting. [...]... formula (top of dialog box) will be changed to (A3 * C3), (A4 * C4) and so on Office VBA: Macros You Can Use Today page 151 Word Procedures Wrd Figure 51 – Copying Formulas in Tables Figure 52 – Copied Formulas View the Appendix to learn how to store this procedure in a Standard module (in a template) page 152 Office VBA: Macros You Can Use Today Word Procedures Option explicit¶ ' * * * * *¶ Private... Visual Basic Editor If you forget to take this step, you ll receive an error: User-defined type not defined In this case, stop the macro, add the reference, and try again Office VBA: Macros You Can Use Today page 143 Word Procedures C o n v e r t in g A u toNum b ered T ex t int o Nor mal Tex t This macro converts AutoNumbered text to plain text, including the numbers Scenario: Perhaps you have been tasked... sFieldCode & "\# " & _¶ Chr$( 34) & NumberFormat & Chr$( 34) & " "¶ fld.Update¶ End If¶ End If¶ End If¶ Next cel¶ End If¶ End Sub¶ ' * * * * *¶ Function TrimCellText(s As String) As String¶ 'Remove end-of-cell markers¶ TrimCellText = Left(s, Len(s) - 2)¶ End Function¶ Set the number format you want to use for the Const NumberFormat value page 150 Office VBA: Macros You Can Use Today Word Procedures Note:... order (a countdown) is desired, such as a “Top 10” This macro inserts numbering in reverse order at the beginning of each paragraph of the current selection page 144 Example file: W011 Office VBA: Macros You Can Use Today Word Procedures Figure 49 – Reverse Numbering Wrd View the Appendix to learn how to store this procedure in a Standard module Option explicit¶ ' * * * * *¶ Sub ReverseNumbering()¶ 'Numbers... automatically Office VBA: Macros You Can Use Today page 147 Word Procedures Note: This macro MUST be named NextCell, which is the name of the Word internal command that is fired when Tab is pressed while your cursor is inside of a table In Word, a macro named with the same name as an internal command will run in place of that command T a b l e s : Su p p r e s s i ng N e w R ow s W h e n T a b b i n g Wrd Use. .. Each bkm In doc.Bookmarks¶ If Left(bkm.Name, Len(identifier)) = _¶ identifier Then bkm.Delete¶ Next¶ End Sub¶ page 1 34 Office VBA: Macros You Can Use Today Word Procedures ' * * * * *¶ Function IsValidEntry(entry As String, _¶ entryLength As Long) As Boolean¶ 'Index entry must be at least 4 characters:¶ 'entry text, space or tab, page nr, para mark¶ IsValidEntry = False¶ If entryLength > 3 Then¶ 'Dont... End If¶ End Sub¶ Office VBA: Macros You Can Use Today page 145 Word Procedures ' * * * * *¶ Sub SetTabIndent(rngSel As Word.Range, indnt As Single)¶ rngSel.Paragraphs.TabStops.Add _¶ Position:=rngSel.Information( _¶ wdHorizontalPositionRelativeToTextBoundary) _¶ + indnt¶ End Sub¶ Consider what to place as a separator between the number and the paragraph text By default, the macro uses a point (period,... way to dynamically display or bring data into Word, thus saving the user lots of manual work Example file: W008 In this example, to display a number in the millions as text, Word's internal \* DollarText and \* CardText switches only work up to 999,999 Figure 47 – Displaying Numbers as Text page 138 Office VBA: Macros You Can Use Today Word Procedures View the Appendix to learn how to store this procedure... Word.Range¶ Set rng = tbl.Range¶ rng.Collapse wdCollapseEnd¶ rng.Select¶ End If¶ End If¶ End Sub¶ page 148 Office VBA: Macros You Can Use Today Word Procedures The macro runs automatically Note: This macro MUST be named NextCell NextCell is the name of the Word internal command that is fired when Tab is pressed while your cursor is inside of a table In Word, a macro named with the same name as an internal command... Example file: W009 Using this macro, exchanging complex field solutions with colleagues, via e-mail or other methods, can be done without having to attach Word documents Office VBA: Macros You Can Use Today page 141 Word Procedures Wrd Figure 48 – Nested Field Codes Pasted as Text View the Appendix to learn how to store this procedure in a Standard module Option explicit¶ ' * * * * *¶ Function InsertFieldInFieldCode( . Word Procedures Office VBA: Macros You Can Use Today page 121 Wrd Figure 45 – Naming and Storing a Macro in Word 5. Once you click OK in the Customize dialog box,. levels. Word Procedures page 122 Office VBA: Macros You Can Use Today Wrd Finding and Replacing in Multiple Documents This procedure demonstrates how to use common Office dialogs and how to loop. Office VBA: Macros You Can Use Today page 129 Wrd Removing All Highlighting This procedure removes all highlighting in a document or part of a document. Example file: W0 04 Tip: If you