tidusx18
8/23/2018 - 6:56 PM

MS Word Laptop Transfer Macros


Sub ListToText()
'
' ListToText Macro
'
'
ActiveDocument.ConvertNumbersToText

End Sub

Sub ZoomHundredPercent()
'
' Sets zoom in active document to 100% - single page
'
'
' ActiveDocument.View.Zoom.Percentage = 100

With ActiveDocument.ActiveWindow.View
 .Zoom.PageColumns = 1
 .Type = wdPrintView
 .Zoom.Percentage = 100
End With

End Sub

Sub MoveAsteriskToBeginning()

Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String

Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.

For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.

Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.
currRng.Select
With Selection.Find
    .ClearFormatting
    .Text = "*"
    '.Font.Bold = True
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .Execute
End With

If Selection.Find.Found Then

With currDoc.Range(Selection.Range.Start, Selection.Range.End)
    .Select
    .Cut
    .StartOf Unit:=wdParagraph
    '.InsertBefore ("*")
    .Paste
    '.InsertAfter "INSERT SOMETHING HERE..."
End With

End If

Next currPara

End Sub

Sub BoldMachingLines()

Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String

Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.

For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.

Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.
currRng.Select
With Selection.Find
    .ClearFormatting
    .Text = "Module:"
    '.Font.Bold = True
    '.Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .Execute
End With

If Selection.Find.Found Then

With currDoc.Range(currPara.Range.Start, currPara.Range.End) 'Selection.Range.Start, Selection.Range.End
    .Select
    '.Cut
    '.StartOf Unit:=wdParagraph
    .Font.Bold = True
    '.InsertBefore ("*")
    '.Paste
    '.InsertAfter "INSERT SOMETHING HERE..."
    .Style = wdStyleHeading1
End With

End If

Next currPara

End Sub

Sub DeleteParagraphs()

Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String

Selection.HomeKey Unit:=wdStory ' Start from the beginning of the doc.

For Each currPara In docRng.Paragraphs ' Loop through the paragraphs in the active document.

Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End) ' Selects the current paragraph, so that the search is conducted paragraph by paragraph.
currRng.Select
With Selection.Find
    '.ClearFormatting
    .Text = "Feedback:"
    .Font.Bold = True
    '.Replacement.Text = ""
    .Forward = True
    '.Wrap = wdFindStop
    '.Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .Execute
End With

If Selection.Find.Found Then

With currDoc.Range(Selection.Range.Start, Selection.Range.End) 'Selection.Range.Start, Selection.Range.End
    .Select
    '.Delete
    '.Cut
    '.StartOf Unit:=wdParagraph
    .Font.Bold = True
    '.InsertBefore ("*")
    '.Paste
    '.InsertAfter ""
End With

End If

Next currPara

End Sub

Sub DeleteParagraphContainingString()

    Dim search As String
    search = "feedback:"

    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs

        Dim txt As String
        txt = para.Range.Text

        If InStr(LCase(txt), search) Then
            para.Range.Delete
        End If

    Next

End Sub

Sub RegexDeleteMatches()

' "Feedback: [\s\S]\d{1,2}\. "
    
    With ActiveDocument.Content.Find
        .Text = ""
        .MatchWildcards = True
        .Forward = True
        .Execute
        If .Found = True Then .Parent.Bold = True
    End With

End Sub