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