#1
|
|||
|
|||
Assistance with VBA Code to identify and highlight dates in a word doc
Hi all. I am hoping someone can help me.
I want to write a code that quality checks work to some degree. Firstly it needs to identify dates in format D MMMM YYYY if the date goes over a page break i would like it to highlight the date in yellow. If the date's year is in the future, highlight the date. any help would be appreciated: starting with this: Sub ChangeDateFormatWithReplaceCommand() Dim myMonth(1 To 12) As String myMonth(1) = "January" myMonth(2) = "February" myMonth(3) = "March" myMonth(4) = "April" myMonth(5) = "May" myMonth(6) = "June" myMonth(7) = "July" myMonth(8) = "August" myMonth(9) = "September" myMonth(10) = "October" myMonth(11) = "November" myMonth(12) = "December" For i = 1 To 12 Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "([0-9]{1,2})& ")" & "(" & myMonth(i)" .Replacement.Text = "?"" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = True .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Next i End Sub Thanks |
#2
|
||||
|
||||
You could do that with a macro like:
Code:
Sub Demo() Application.ScreenUpdating = False With ActiveDocument.Range With .Find .ClearFormatting .Replacement.ClearFormatting .Text = "<[0-9]{1,2} [JFMASONDanuryebchpilgstmov]{3,9} [12][0-9]{3}>" .Replacement.Text = "" .Forward = True .Format = False .Wrap = wdFindStop .MatchWildcards = True .Execute End With Do While .Find.Found = True If .Characters.First.Information(wdActiveEndAdjustedPageNumber) _ <> .Characters.Last.Information(wdActiveEndAdjustedPageNumber) Then .HighlightColorIndex = wdBrightGreen End If .Collapse wdCollapseEnd .Find.Execute Loop End With Application.ScreenUpdating = True End Sub Code:
Sub Demo() Application.ScreenUpdating = False With ActiveDocument.Range.Find .ClearFormatting .Replacement.ClearFormatting .Text = "<([0-9]{1,2}) ([JFMASONDanuryebchpilgstmov]{3,9}) ([12][0-9]{3})>" .Replacement.Text = "\1^s\2^s\3" .Forward = True .Format = False .Wrap = wdFindContinue .MatchWildcards = True .Execute Replace:=wdReplaceAll End With Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
date |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Require assistance in writing code to login to webmail account. | saurabhlotankar | Excel Programming | 4 | 05-21-2015 10:47 AM |
Assistance with Word 2010 If formula | ciresuark | Word | 1 | 03-09-2015 12:57 PM |
Help with VBA code to find and highlight text | mpdsal | Word VBA | 8 | 09-11-2014 03:55 PM |
Code to add dates | terricritch | Excel Programming | 10 | 11-08-2011 09:51 AM |
find - reading highlight - highlight all / highlight doesn't stick when saved | bobk544 | Word | 3 | 04-15-2009 03:31 PM |