VBA Word - Little Tips

Sub CLOSE_ALL_WINDOWS()

'_______________________________________________
'

'This macro for Word closes all windows WITHOUT saving
'_______________________________________________
'

On Error GoTo MyHand

While (Documents.COUNT >= 1) = True
    ActiveWindow.Close SaveChanges:=wdDoNotSaveChanges
Wend


MyHand:
    If Err = 4248 Then
        Exit Sub
    End If

End Sub


Sub paginate()


'_______________________________________________
'

'This macro for Word inserts simple pagination for each page, top and center
'_______________________________________________
'

    With Selection.Sections(1).Headers(1).PageNumbers
        .NumberStyle = wdPageNumberStyleArabic
        .HeadingLevelForChapter = 0
        .IncludeChapterNumber = False
        .ChapterPageSeparator = wdSeparatorHyphen
        .RestartNumberingAtSection = False
        .StartingNumber = 0
    End With
    Selection.Sections(1).Headers(1).PageNumbers.Add PageNumberAlignment:= _
        wdAlignPageNumberCenter, FirstPage:=True
End Sub


Sub Tabs_Clear()


'_______________________________________________
'

'This macro for Word clears all tabs in all the document
'_______________________________________________
'

Selection.WholeStory
Selection.ParagraphFormat.TabStops.ClearAll

End Sub


Sub Language_ENG()

'_______________________________________________
'

'This macro for Word sets the language of the whole document to English UK
'_______________________________________________
'

    Selection.WholeStory
    Selection.LanguageID = wdEnglishUK
    Selection.HomeKey Unit:=wdStory
End Sub

Sub Language_SPA()

'_______________________________________________
'

'This macro for Word sets the language of the whole document to Modern Spanish
'_______________________________________________
'

    Selection.WholeStory
    Selection.LanguageID = wdSpanishModernSort
    Selection.HomeKey Unit:=wdStory
End Sub

Sub Language_FRE()
'_______________________________________________
'

'This macro for Word sets the language of the whole document to French France
'_______________________________________________
'
    Selection.WholeStory
    Selection.LanguageID = wdFrench
    Selection.HomeKey Unit:=wdStory
End Sub


Sub Add_Blank_Document()

'_______________________________________________
'

'This macro for Word adds a blank document
'_______________________________________________
'


If Documents.Count < 1 Then
   Documents.Add
End If
End Sub


Sub CombineFiles()

'_______________________________________________
'

' This macro for Word works with text files. It inserts
' one line of file 1, then one line of file 2, into a third file
'_______________________________________________
'


Dim i As Integer

Open "C:\First_File.txt" For Input As #1
Open "C:\Second_File.txt" For Input As #2
Open "C:\Result.txt" For Output As #3

'loop through first file
Do While Not EOF(1)
Do While Not EOF(2)

Line Input #1, MyString1

Print #3, MyString1

'loop through second file
Line Input #2, MyString2

Print #3, MyString2
Loop
Loop

MsgBox "Done"

Close #3
Close #2
Close #1

End Sub




Sub CopyFile()
'_______________________________________________
'

' This macro for Word copies a file.
'_______________________________________________
'   
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile "C:\File-1.txt", "C:\Copy-of-File-1.txt", True
    Set fso = Nothing
   
End Sub

VBA Proofing - Add AutoCorrect Entry

Sub Automatically_Add_AutoCorrect_Entry()

'______________________________________
'
' This VBA macro adds an AutoCorrect Entry
' For example, "vba macro" becomes "VBA macro"
' This quick macro works in Word
'______________________________________
'
    AutoCorrect.Entries.Add Name:="vba macro", Value:="VBA macro"
 
    With AutoCorrect
        .ReplaceText = True
    End With
 
End Sub

VBA String Manipulations - Remove HTML tags

Sub RemoveTags()
' ______________________________________
'
' This macro removes tags such as < and >
' from a web page source code
' It works in Word
' ______________________________________
'

Dim MyRange As Range
Dim pos As Long

Set MyRange = ActiveDocument.Range
 With MyRange.Find
  Do While .Execute(findText:="(\<*\>)", _
   MatchWildcards:=True, _
   Wrap:=wdFindStop, Forward:=True) = True
   MyRange.Delete
  Loop
 End With

Set MyRange = Nothing

MsgBox "end macro"

End Sub


'______________________________________

'Another way to do the same job of removing html tags from the source code of a web page is:

'______________________________________

Sub Remove_All_Tags()
'______________________________________
'
' This VBA macro removes all tags from
' the source code of a web page
' For example, "<b>This text</b>"
' becomes "This text"
' This quick macro works in Word
'______________________________________
'
ActiveDocument.Select
If Selection.Find.Execute("<", 0, 0) Or Selection.Find.Execute("</", 0, 0) = True Then

Do

Selection.Extend (">")
Selection.Delete

ActiveDocument.Select

Loop Until Selection.Find.Execute("<", 0, 0) = False

Else
MsgBox "No < > tag was found"
End If

End Sub