How to find and copy a table below a specified text - vba

I have a word document with multiple text labels followed by its respective tables.
I want to find a text and then copy the table immediately below it so i can paste it in other document.
Sub EWT()
Dim para As Paragraph
Dim textA As String
For Each para In ActiveDocument.Paragraphs
If Not para.Range.Information(wdWithInTable) Then
textA = para.Range.Text
Debug.Print textA
'How to get the table just below this and copy it?
End If
Next
End Sub

The following is a general way of finding tables. In short, make a new range, assign the start of where the text leaves off, and the end is the end of the document. It'd be the first table. As an additional suggestion, avoid the Information function. One reason is it's slow.
Sub EWT()
Dim para As Paragraph
Dim textA As String
For Each para In ActiveDocument.Paragraphs
If Not para.Range.Information(wdWithInTable) Then
textA = para.Range.Text
para.Range.Select 'Debug only
Dim myRange As Range
Set myRange = ActiveDocument.Range
myRange.Start = para.Range.End
myRange.End = ActiveDocument.Range.End
Dim myTable As Table
Set myTable = myRange.Tables(1)
myTable.Select 'Debug only
Debug.Print textA
'How to get the table just below this and copy it?
End If
Next End Sub
Then again, it looks like you're wanting to find every table in the document, since your Find doesn't look for any specific text, just text. If that's the case, this is quicker:
Sub FindTables()
Dim myDocument As Document
Set myDocument = ActiveDocument
Dim myTable As Table
For Each myTable In myDocument.Tables
myTable.Select
Next End Sub

Related

Add a number of tables to a bookmark in Word VBA while maintaining and expanding the bookmark

I'm trying to create some automation using Word VBA and looking for some advice.
I have a bookmark in a document. What I want to do is call some VBA that goes to that bookmark and creates a number of tables, could be 1, could be 50 depending on some variables.
I would like to maintain that bookmark so that it covers the entirety of that new section of tables so that if someone runs the macro again, the tables are dropped and recreated nicely.
So far I have some code that creates the tables at the bookmark and recreates it but it seems to be creating the bookmark in the first cell as the tables nest.
Can anybody help me?
Private Sub InsertTableInBookmark(BookmarkName As String)
Debug.Print "[INFO] Started Private Sub InsertTableInBookmark"
Dim objRng As Range
Dim objTable As Table
Selection.GoTo what:=wdGoToBookmark, Name:=BookmarkName
Selection.Expand wdParagraph
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=9, NumColumns:=4, DefaultTableBehavior:=wdWord9TableBehavior
ActiveDocument.Bookmarks.Add BookmarkName, Selection.Range
Debug.Print "[INFO] Finished Private Sub InsertTableInBookmark"
End Sub
Thanks.
Try:
Private Sub InsertTableInBookmark(BmkNm As String, t As Long)
Dim i As Long, BmkRng As Range, Tbl As Table
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
Set BmkRng = .Bookmarks(BmkNm).Range
For i = 1 To t
Set Tbl = .Tables.Add(Range:=BmkRng.Characters.Last, _
NumRows:=9, NumColumns:=4, DefaultTableBehavior:=wdWord9TableBehavior)
With BmkRng
.End = Tbl.Range.End
If i < t Then
.Characters.Last.Next.InsertBefore vbCr & vbCr
.End = .End + 2
End If
End With
Next
.Bookmarks.Add BmkNm, BmkRng
End If
End With
Set BmkRng = Nothing
End Sub
Note that I've added another parameter to the sub - t - for the number of tables to insert.

Word VBA: How to Fix FOR EACH loop to add bookmark to each sentence?

Within a Word docx: I'm trying to add a bookmark to each sentence. For example, at first sentence would be bookmark "bmarkpg01" and second sentence would be bookmark ""bmarkpg01ln01col01"". My code adds only one bookmark to first sentence and doesn't loop through to end of document.
I've tried a for each loop to attempt each sent in sentences and each bmark in bookmark.
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
For Each bmark In ActiveDocument.Bookmarks
ActiveDocument.Bookmarks.Add Name:="pmark" & bmark.Range.Information(wdActiveEndAdjustedPageNumber), Range:=myRange 'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
Next
End Sub
EXPECTED RESULT: Within entire document, each sentence has a corresponding bookmark and bookmark name ("bmarkpg01ln01col01", "bmarkpg01ln02col10", etc.)
ACTUAL RESULTS: only one bookmark is added to the first sentence of the document.
The following works for me, as far as the requirements in the question go.
Please remember to put Option Explicit at the top of a code page. This will force you to declare ("Dim") variables, but will also save time and trouble as it will prevent typos and warn you of other problems.
A Sentence in Word returns a Range object, so the code below delares MySent As Range. This provides the target Range for the Bookmarks.Add method.
If you won't be doing anything else with the bookmark, it's not strictly necessary to Set bkm = when adding the bookmark. I left it in since it is declared in the code in the question.
It's not necessary to loop the collection of bookmarks - espeicially since there aren't any - they're being added.
I've added some code for naming the bookmarks, as well.
Sub tryAddBmarkatSentence()
Dim doc As Word.Document
Dim MySent As Word.Range
Dim bmark As Bookmark
Application.ScreenUpdating = False
Set doc = ActiveDocument
For Each MySent In doc.Sentences
Set bmark = doc.Bookmarks.Add(Name:="bmark" & _
MySent.Information(wdActiveEndAdjustedPageNumber) & "_" &_
MySent.Information(wdFirstCharacterLineNumber) & "_" & _
MySent.Information(wdFirstCharacterColumnNumber), Range:=MySent)
'bmark name would have added info of page, line, and col number. here as example is pagenumber.
Next
End Sub
u can try like this
Sub tryAddBmarkatSentence()
Dim myRange As Range
Set myRange = ActiveDocument.Content
Dim bmark As Bookmark
Application.ScreenUpdating = False
For Each MySent In ActiveDocument.Sentences
ActiveDocument.Bookmarks.Add ... and the rest of the code.
//i dont know how you define witch bookmark is to asign to that sentence
Next
End Sub

Creating multiple Word paragraphs with Document.Paragraphs.Add()

I'm using a macro in Excel to add information to a Word document. I'm trying to add 10 lines to an existing Word document like this:
Sub AddParagraphs()
'Open Word
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
'Open
Dim doc As Word.document
Set doc = wordApp.Documents.Open("c:\temp\document.docx")
'Add 10 paragraphs
Dim idx As Integer
For idx = 1 To 10
Dim paragraph As Word.paragraph
Set paragraph = doc.Paragraphs.Add()
paragraph.Range.style = wdStyleHeading2
paragraph.Range.text = "Paragraph " & CStr(idx)
Next
doc.Save
doc.Close
wordApp.Quit
End Sub
I have an empty Word document at C:\temp\document.docs but after running the code there is only one line with the text "Paragraph 10". I was expecting 10 lines.
As far as I can tell the Paragraphs.Add() with no arguments should create a new paragraph. Perhaps I'm mistaken to believe that a new paragraph produces a new line? Is there another way to add 10 lines in a loop where each can have a specific (not the same) style?
The "paragraph" that you are adding does not have a paragraph mark at the end.
Change that line to
paragraph.Range.Text = "Paragraph " & CStr(idx) & vbCr
and that should fix your problem.
Actually, what's happening in the original code is that you're always replacing the content when you use
Doc.Paragraphs.Add
So there's only ever the one paragraph. There are various ways to get around this. One is to use InsertAfter, as has been mentioned in comments. (Note that if you're going to use this, the correct way to specify a new paragraph as part of a string is vbCr or Chr(13). Word can very easily misinterpret anything else!)
My personal preference is to work with a Range object that can be manipulated independently of the entire document. For example, it can be done like this:
Sub AddParagraphs()
'Open Word
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
'Open
Dim doc As Word.document
Set doc = wordApp.Documents.Open("c:\temp\document.docx")
Dim rng as Word.Range
Set rng = doc.Content
'Add 10 paragraphs
Dim idx As Integer
For idx = 1 To 10
Dim paragraph As Word.paragraph
'So that the next thing inserted follows instead of replaces
rng.Collapse wdCollapseEnd
Set paragraph = rng.Paragraphs.Add
paragraph.Range.style = wdStyleHeading2
paragraph.Range.text = "Paragraph " & CStr(idx)
Next
doc.Save
doc.Close
wordApp.Quit
End Sub
I had a similar problem. Adding doc.Range.InsertParagraphAfter fixed my problems. The following code should work for you:
Sub AddParagraphs()
'Open Word
Dim wordApp As Word.Application
Set wordApp = CreateObject("Word.Application")
'Open
Dim doc As Word.document
Set doc = wordApp.Documents.Open("c:\temp\document.docx")
'Add 10 paragraphs
Dim idx As Integer
For idx = 1 To 10
Dim paragraph As Word.paragraph
Set paragraph = doc.Paragraphs.Add()
paragraph.Range.style = wdStyleHeading2
paragraph.Range.text = "Paragraph "
doc.Range.InsertParagraphAfter
Next
doc.Save
doc.Close
wordApp.Quit
End Sub
The Paragraphs.Add method appends a new paragraph consisting of the paragraph mark only at the end of the document. Oddly enough, the return value is not the now last paragraph but the penultimate paragraph. You get a reference to the new last paragraph by the Next method of the paragraph object. You can then set the style and insert text with the paragraph.Range.InsertBefore method.
The critical part of your code must be like this
'Add 10 paragraphs
Dim idx As Integer
Dim paragraph As word.paragraph
For idx = 1 To 10
Set paragraph = doc.Paragraphs.Add.Next
paragraph.Range.style = word.WdBuiltinStyle.wdStyleHeading2
paragraph.Range.InsertBefore "Paragraph " & CStr(idx)
Next

Highlight All Bookmarks in Word Doc Via VBA

I want to highlight all the bookmarks in my Word document. When I try to show the bookmarks, I only get the "I". And this code doesn't do anything.
Just like one of the commentators wrote, my bookmarks are 0 length. But even then how can I highlight say 2 spaces forward?
Sub BookMarks2Bold()
Dim bm As Bookmark
Dim tx As Range
Set tx = ActiveDocument.StoryRanges(wdMainTextStory)
For Each bm In tx.Bookmarks
bm.Range.HighlightColorIndex = wdYellow
Next
End Sub
If your bookmarks are zero range and you still want to highlight something in the document, you can extend the bookmark range, e.g. be the following character in the document:
Sub BookMarks2Bold()
Dim bm As Bookmark
Dim tx As Range
dim rng as Range
Set tx = ActiveDocument.StoryRanges(wdMainTextStory)
For Each bm In tx.Bookmarks
set rng = bm.Range
rng.MoveEnd wdCharacter ' extend by one character
' optionally, expand by one word
' rng.Expand wdWord
rng.HighlightColorIndex = wdYellow
Next
End Sub

Use Word VBA to color cells in tables based on cell value

In Word I have a document with multiple tables full of data. Hidden inside these cells (out of view but the data is there) is the Hex code of the color I want to shade the cells. I chose the hex value just because it's relatively short and it's a unique bit of text that won't be confused with the rest of the text in the cell.
I've found some code online to modify but I can't seem to make it work. It doesn't give any errors, just nothing happens. I feel like the problem is in searching the tables for the text value but I've spent hours on this and I think I've confused myself now!
Sub ColourIn()
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
Dim oClr As String
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Range.Cells
Set oRng = oCel.Range
oRng.End = oRng.End - 1
If oRng = "CCFFCC" Then
oCel.Shading.BackgroundPatternColor = wdColorLightYellow
End If
If oRng = "FFFF99" Then
oCel.Shading.BackgroundPatternColor = wdColorPaleBlue
End If
Next
Next
End Sub
Thanks!
Edit:
I've also tried this code wit the same result of nothing happening:
Sub EachCellText()
Dim oCell As Word.Cell
Dim strCellString As String
For Each oCell In ActiveDocument.Tables(1).Range.Cells
strCellString = Left(oCell.Range.Text, _
Len(oCell.Range.Text) - 1)
If strCellString = "CCFFFF" Then
oCell.Shading.BackgroundPatternColor = wdColorLightGreen
If strCellString = "CCFFCC" Then
oCell.Shading.BackgroundPatternColor = wdColorLightYellow
If strCellString = "FFFF99" Then
oCell.Shading.BackgroundPatternColor = wdColorPaleBlue
End If
End If
End If
Next
End Sub
Your Code is getting stuck nowhere. But you are checking the whole Cell Value against the Hex code, and this will not work since "blablabla FFFFFF" is never equal to "FFFFFF". So you have to check if the Hex code is in the Cell value:
Sub ColourIn()
Dim oTbl As Table
Dim oCel As Cell
Dim oRng As Range
Dim oClr As String
For Each oTbl In ActiveDocument.Tables
For Each oCel In oTbl.Range.Cells
Set oRng = oCel.Range
oRng.End = oRng.End - 1
Dim cellvalue As String
'check if Colorcode is in cell
If InStr(oRng, "CCFFCC") Then
'Set Cell color
oCel.Shading.BackgroundPatternColor = wdColorLightYellow
'Remove Colorcode from Cell
cellvalue = Replace(oRng, "CCFFCC", "")
'load new value into cell
oRng = cellvalue
End If
Next
Next
End Sub
Now you just have to add all the colors you want to use (I would prefer a Select Case statement) and the code should work fine