#1
|
|||
|
|||
VBA to cut colored text from one document and paste to another
Hi,
Document contains this text: 1 Now a Green Text 2 Label this in Black 3 Soft Kitty 4 Dog owners are great. 5 Spelling is not my forte 6 Measure Twice 7 Distance Measure The following code will find 1st instance of the yellow text and Cut/Paste it to a new document. On the second loop it crashes at Selection.Range.Paste with Object empty error. Not sure what the issue is. Likely that I am quite new to VBA and Word docs. Any help would be appreciated. Sub FindYellowText() Dim oResponse As Document Selection.HomeKey wdStory With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .MatchWildcards = False .Forward = True .Wrap = wdFindStop .Font.ColorIndex = wdYellow .Execute Do Until Not .Found If Selection.Range.Font.ColorIndex = wdYellow Then Selection.Range.Cut Set oResponse = Documents.Add With oResponse Selection.Range.Paste End With End If .Execute Loop End With End Sub |
#2
|
|||
|
|||
Hi, try this:
Code:
Sub FindYellowText() Dim oSel As range Dim oResponse As Document Set sel = ActiveDocument.range Set oResponse = Documents.Add With sel.Find .ClearFormatting .Replacement.ClearFormatting .text = "" .MatchWildcards = False .Forward = True .Wrap = wdFindStop .Font.ColorIndex = wdYellow .Execute Do Until Not .found If sel.Font.ColorIndex = wdYellow Then sel.Cut With oResponse selection.range.Paste selection.MoveStart unit:=wdParagraph selection.TypeParagraph End With End If .Execute Loop End With End Sub |
#3
|
|||
|
|||
Vivka,
Worked like a charm. Thank you. Cheers Onjai |
#4
|
|||
|
|||
Onjai, my pleasure!
|
#5
|
|||
|
|||
Find Green Text in multiple Word documents
Trying to loop through multiple docs in a folder, cut out green colored text, paste green text to new doc, save both docs in same folder. Code crashes on .Activate. Set statement is empty. Not sure why?
Code:
Sub FindGreenText() Application.ScreenUpdating = False Dim oSel As Range Dim oResponse As Document Dim oDoc As Document Dim strDocName As String, strPath As String, strFile As String, strFolder As String strFolder = "<folder location with doc files>" strFile = Dir(strFolder & "\*.docx", vbNormal) Set oDoc = Documents.Open(FileName:=strFolder & " \ " & strFile, AddToRecentFiles:=False, Visible:=True) While strFile <> "" oDoc.Activate 'code stops here with empty set statement 'DoEvents strDocName = Left(oDoc.Name, InStrRev(oDoc.Name, Chr(46)) - 1) strDocName = strDocName & "_response.docx" strPath = oDoc.Path & Chr(92) Set sel = ActiveDocument.Range Set oResponse = Documents.Add With sel.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .MatchWildcards = False .Forward = True .Wrap = wdFindStop .Font.ColorIndex = wdGreen .Execute Do Until Not .Found If sel.Font.ColorIndex = wdGreen Then sel.Cut With oResponse Selection.Range.Paste Selection.MoveStart unit:=wdParagraph Selection.TypeParagraph End With End If .Execute Loop End With oDoc.SaveAs2 oResponse.SaveAs2 strPath & strDocName oDoc.Close oResponse.Close strFile = Dir() Wend Application.ScreenUpdating = True MsgBox "Lucy, I'm home!" End Sub |
#6
|
|||
|
|||
Hi! What I've noticed at once:
1. There are unnedeed spaces before & after the backslash in: strFolder & " \ " & strFile 2. Use either sel or oSel, not both. |
#7
|
|||
|
|||
ahh, that was it!
Now for a very interesting twist.... code works for wdYellow text and not for wdGreen text. I tried this several times and cannot understand why. Anyone have a suggestion or thought? |
#8
|
|||
|
|||
Your code does work for WdGreen! The problem is your green font isn't actually the vba WdGreen,
although Word sets it as green. The vba green & the Word green have the same value (11) but are different colors! Check for yourself using RGB codes: the genuine (vba) WdGreen is R=0, G=128, B=0 but your Word green is anything else. It's strange, but the Word's Find-Replace dialogue recognizes the Word's green, set using the Find-Replace Format Font dialogue, but doesn't recognize the vba WdGreen, while the vba / macro code recognizes the vba WdGreen but is blind to the Word Green. To make the macro work for your "green", select any part of the colored text & use msgbox selection.Font.ColorIndex to get the code of your color. Then replace WdGreen in Find with the obtained code. |
#9
|
|||
|
|||
The code works for other colors, not green.
The only way I was able to fix this was to: msgbox Selection.Font.Color It returned 5287936. Changed the Find to: .Font.Color = 5287936 Works! Not sure why it is like this. Thank you Vivka! |
#10
|
|||
|
|||
You are most welcome!
|
#11
|
|||
|
|||
Posting working code.
Code:
Sub FindGreenText() 'speed up procedure Application.ScreenUpdating = False Dim sel As Range Dim oResponse As Document Dim oDoc As Document Dim strDocName As String, strPath As String, strFile As String, strFolder As String 'point to location of files strFolder = "<folder with .docx files>" strFile = Dir(strFolder & "\*.docx", vbNormal) 'process each .docx file in folder While strFile <> "" Set oDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=True) oDoc.Activate 'name the .docx file with a new name for responses strDocName = Left(oDoc.Name, InStrRev(oDoc.Name, Chr(46)) - 1) strDocName = strDocName & "_response.docx" 'sets the path to save new .docx file based on location of original .docx file(oDoc) strPath = oDoc.Path & Chr(92) Set sel = ActiveDocument.Range Set oResponse = Documents.Add With sel.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .MatchWildcards = False .Forward = True .Wrap = wdFindStop 'finds green colored text .Font.Color = 5287936 .Execute Do Until Not .Found If sel.Font.Color = 5287936 Then sel.Cut 'pastes green text to new .docx With oResponse Selection.Range.Paste Selection.MoveStart unit:=wdParagraph Selection.TypeParagraph End With End If .Execute Loop End With oDoc.SaveAs2 oResponse.SaveAs2 strPath & strDocName oDoc.Close oResponse.Close strFile = Dir() Wend Application.ScreenUpdating = True MsgBox "Lucy, I'm home!" End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Copy selected text from one document and paste to new document in same position on the page | gasparik | Word VBA | 1 | 05-11-2020 05:41 AM |
Why do pages 10-24 disappear when I type in more text on page 2 or paste new text into the document? | RET | Word | 1 | 05-02-2016 07:28 PM |
colored background to text | userman | Word | 2 | 09-26-2012 01:52 AM |
not showing colored text from external emails | MasterGator | Outlook | 0 | 01-31-2012 02:20 PM |
Making text boxes with colored bar at the top | daviddoria | PowerPoint | 0 | 08-30-2009 03:19 PM |