#1
|
|||
|
|||
Text Insert
I want to insert the text before & after the tables based on the below conditions: Selection of a folder was through browse option... IF A SEARCH STRING IS AVAILABLE IN MORE THAN ONE TABLE THEN IT SHOULD BE CONSIDERED FIRST OCCURENCE STRING ONLY AND INSERT THE CORRESPONDENCE TEXT TO THE ABOVE AND BELOW OF THE TABLE OUTSIDE STRUCTURE AND IGNORE THE REMAINING AVAILABLE STRINGS IN OTHER TABLES. CONSIDER ONLY FIRST OCCURENCE STRING & INSERT THE TEXT BASED ON THAT ONLY. BUT THE BELOW CODE WAS INSERTING CORRESPONDENCE TEXT WHEREEVER THE SEARCH STRING IS AVAIABLE. Suppose "BBEGINING" is available in the table 3, table 5, table 6, table 7, table 9 it should be considered first occurence only and ignore the remaining tables. Here insert "123" is insert at table 3 only (First occurence & remaining tables has to be ignored) to the above of that table.(outside of the table structure) if "BBEGINING" is found anywhere in the table then insert "123" to the above of that table.(outside of the table structure) if "EBEGINING" is found anywhere in the table then insert "456" to the above of that table.(outside of the table structure) if "IBEGINING" is found anywhere in the table then insert "789" to the above of that table.(outside of the table structure) if "BENDING" is found anywhere in the table then insert "333" to the below of that table.(outside of the table structure) if "EENDING" is found anywhere in the table then insert "666" to the below of that table.(outside of the table structure) if "IENDING" is found anywhere in the table then insert "999" to the below of that table.(outside of the table structure) Please review the code: (*) Inserted text only once in a table based on the first occurence only & ignore if it is available in another tables. (*) Table above & below there is a running text and before inserting a text above or below to the table a double enter has to be entered between the running text and tables (above & below) to insert the text. Your help is highly coperated. Below code was running but it want to update with the above criteria. Code:
Sub InsertTextAroundTables_BATCHFINAL_working_no_issue() Dim folderPath As String Dim fileDialog As fileDialog Dim fileName As String Dim doc As Document Dim searchTextAbove As Variant Dim searchTextBelow As Variant Dim insertTextAbove As Variant Dim insertTextBelow As Variant Dim i As Integer ' Define search strings and corresponding texts to insert searchTextAbove = Array("BBEGINING", "EBEGINING", "IBEGINING") searchTextBelow = Array("BENDING", "EENDING", "IENDING") insertTextAbove = Array("123", "456", "789") insertTextBelow = Array("333", "666", "999") ' Prompt user to select a folder Set fileDialog = Application.fileDialog(msoFileDialogFolderPicker) With fileDialog .Title = "Select a Folder Containing Word Documents" If .Show = -1 Then folderPath = .SelectedItems(1) Else MsgBox "No folder selected. Exiting macro.", vbExclamation Exit Sub End If End With ' Loop through each Word document in the folder fileName = Dir(folderPath & "\*.docx") Do While fileName <> "" ' Open the document Set doc = Documents.Open(folderPath & "\" & fileName) ' Loop through each table in the document For Each tbl In doc.Tables ' Check if there's any running text before the table If tbl.range.start > doc.range.start Then ' Insert a line break before inserting text above the table doc.range(tbl.range.start - 1).InsertBefore vbCrLf End If ' Check if table contains any of the search strings For i = LBound(searchTextAbove) To UBound(searchTextAbove) If InStr(1, tbl.range.text, searchTextAbove(i)) > 0 Then ' Insert text above the table Set rng = tbl.range.Duplicate rng.Collapse Direction:=wdCollapseStart rng.MoveStart Unit:=wdCharacter, Count:=-1 rng.InsertBefore insertTextAbove(i) & vbCrLf Exit For End If Next i For i = LBound(searchTextBelow) To UBound(searchTextBelow) If InStr(1, tbl.range.text, searchTextBelow(i)) > 0 Then ' Insert text below the table Set rng = tbl.range.Duplicate rng.Collapse Direction:=wdCollapseEnd rng.MoveEnd Unit:=wdCharacter, Count:=1 rng.InsertAfter vbCrLf & insertTextBelow(i) Exit For End If Next i Next tbl ' Save and close the document doc.Save doc.Close ' Get the next file in the folder fileName = Dir Loop ' Inform user that the operation is complete MsgBox "Text has been inserted around tables in all documents in the selected folder.", vbInformation End Sub |
#2
|
||||
|
||||
Rather than looping through every table, I would use the Find command along the following lines.
Code:
Sub TableTags() Dim str As String, aRng As Range, sPrefix() As String, i As Integer Dim insertTextAbove() As String, insertTextBelow() As String sPrefix = Split("B|E|I", "|") insertTextAbove = Split("123|456|789", "|") insertTextBelow = Split("333|666|999", "|") For i = LBound(sPrefix) To UBound(sPrefix) Set aRng = ActiveDocument.Range With aRng.Find .Forward = True .Text = sPrefix(i) & "BEGINING" If .Execute Then If aRng.Information(wdWithInTable) Then Set aRng = aRng.Tables(1).Range aRng.Collapse Direction:=wdCollapseStart aRng.MoveStart Unit:=wdCharacter, Count:=-1 aRng.InsertBefore vbCrLf & insertTextAbove(i) GoTo NextOne End If End If End With NextOne: Next i For i = LBound(sPrefix) To UBound(sPrefix) Set aRng = ActiveDocument.Range With aRng.Find .Forward = False .Text = sPrefix(i) & "ENDING" If .Execute Then If aRng.Information(wdWithInTable) Then Set aRng = aRng.Tables(1).Range aRng.Collapse Direction:=wdCollapseEnd 'aRng.MoveEnd Unit:=wdCharacter, Count:=1 aRng.InsertAfter insertTextBelow(i) & vbCrLf GoTo NextTwo End If End If End With NextTwo: Next i End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Tags |
text insert |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Insert text box | otuatail | Word | 2 | 11-13-2022 08:33 AM |
VBA Word - Find Text Font Color - Insert New Text | jc491 | Word VBA | 2 | 01-04-2016 05:42 PM |
VBA Search Table for Text/Select Text/Insert Hyperlink | sldrellich | Word VBA | 3 | 03-24-2015 01:09 PM |
Insert a text conditionally | deboer | Word | 1 | 05-04-2014 03:35 PM |
Macro to insert Text | Morte | Excel Programming | 1 | 03-04-2014 04:33 PM |