Word VBA: how to split paragraph into two styles? - vba

I made a program that goes through the document and if there is a paragraph with tab in it, it splits it in two:
sSPlit = Split(aPara.Range.Text, vbTab)
aPara.Range.Text = sSPlit(0) & vbCrLf & sSPlit(1)
That works great. The problem is, I'd like the first splitted paragraph to have "Style1" and the second "Style2".
aPara.Style = "Style1"
adds this style to the next, yet unsplitted paragraph. Please help.

One possible solution is to calculate the ranges to apply the style to and then simply retrieve the range of calculated characters, e.g.:
Dim par1Start As Integer
Dim par2Start As Integer
par1Start = aPara.Range.Start
par2Start = par1Start + Len(sSplit(0)) + 1
aPara.Range.Text = sSplit(0) & vbCrLf & sSplit(1)
ActiveDocument.Range(par1Start, par2Start).Style = "Style1"
ActiveDocument.Range(par2Start, par2Start + Len(sSplit(1))).Style = "Style2"

Related

How do I get all text from all cells to one variable?

I have a large range that I need to find all numbers that is between four and six digits long.
I know I can use regex for this but I don't want to loop each cell and check them all.
What I need is kind of selecting the range copy and paste in notepad and copy back to a variable.
This way I can regex the variable and find all matches at once.
I don't need to know where the number was found, I just need the numbers.
Is there any way to copy the values to a string like this?
Dim text As String
text = ActiveSheet.Range("C9:IQ56").Value
is not compatible datatypes.
If I use variant I get an array of the columns and cells.
My attempt to join the array is not successful either.
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(text(i))
Next i
Any help with this?
use Application Index to do each row at a time:
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(application.Index(text,i,0))
Next i
There are two problems in your code, the declaration and the dimensions of the variable. Here is what you can do:
Dim Text() As Variant
Text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(Text, 1)
For j = 1 To UBound(Text, 2)
textstring = textstring & " " & Text(i, j)
Next j
Next i
Similar approach with delimiters concatenating row strings after loop
Added a Timer and the feature to use separators (delimiters) as well for rows (e.g. "|") as for columns (e.g. ","). Furthermore I demonstrate a way to join all row strings at once after loop via Application.Transpose() just for the sake of the art, though this isn't faster nor slower than #Scott Craner 's valid solution :+).
Code
Sub arr2txt()
Const SEPROWS As String = "|" ' << change to space or any other separator/delimiter
Const SEPCOLS As String = "," ' << change to space or any other separator/delimiter
Dim v
Dim textstring As String, i As Long
Dim t As Double: t = Timer ' stop watch
v = ActiveSheet.Range("C2:E2000").Value ' get data into 1-based 2-dim datafield array
For i = 1 To UBound(v, 1)
v(i, 1) = Join(Application.Index(v, i, 0), SEPCOLS)
Next i
textstring = Join(Application.Transpose(Application.Index(v, 0, 1)), SEPROWS)
Debug.Print Format(Timer - t, "0.00 seconds needed")
End Sub

VBA script to replace cell value and keep formatting

I have the below table in word that I'm trying to write a script to replace the contents of the below cell with a different customer payment (i.e replace the £1,100 with £2,000). Below is a snippet of my script but the when I write back to the cell it loses all the formatting and the numbered list.
How can I keep replace the cell data with very similar data and still keep the formatting?
ps. I've simplified the contents of the cell to make it easier to read, so the code won't apply to exactly that content
DescPlan = Trim(t1.Cell(2, 2).Range.Text)
DescTest = InStr(1, DescPlan, ":")
finalString = Left(DescPlan, DescTest)
t1.Cell(2, 2).Range.Text = Replace(DescPlan, finalString, "Payment by the customer of " + Format(v, "Currency") + " will be due upon completion of items below:")
Not sure if this helps but you are using a table so what works for excel should also work for you.
Sub replace_keep_format()
Dim t1 As Range
Dim sStrng As String, rStrng As String
Dim i As Integer
sStrng = "£1,100"
rStrng = "£2,000"
i = 1
Do Until ThisWorkbook.Sheets(1).Range("a" & i) = ""
Set t1 = ThisWorkbook.Sheets(1).Range("a" & i)
t1 = Replace(Expression:=t1, Find:=sStrng, Replace:=rStrng)
i = i + 1
Loop
End Sub

Sampling StringName.SubString(p,1) for paragraph formatting character

please try to specifically answer my question and not offer alternative approaches as I have a very specific problem that needs this ad-hoc solution. Thank you very much.
Automatically my code opens Word through VB.NET, opens the document, finds the table, goes to a cell, moves that cells.range.text into a String variable and in a For loop compares character at position p to a String.
I have tried Strings:
"^p", "^013", "U+00B6"
My code:
Dim nextString As String
'For each cell, extract the cell's text.
For p = 17 To word_Rng.Cells.Count
nextString = word_Rng.Cells(p).Range.Text
'For each text, search for structure.
For q = 0 To nextString.Length - 1
If (nextString.Substring(q, 1) = "U+00B6") Then
Exit For
End If
Next
Next
Is the structural data lost when assigning the cells text to a String variable. I have searched for formatting marks like this in VBA successfully in the past.
Assuming that your string contains the character, you can use ChrW to create the appropriate character from the hex value, and check for that:
If nextString.Substring(q, 1) = ChrW(&h00B6) Then
Exit For
End If
UPDATE
Here's a complete example:
Dim nextString = "This is a test " & ChrW(&H00B6) & " for that char"
Console.WriteLine(nextString)
For q = 0 To nextString.Length - 1
If nextString(q) = ChrW(&H00B6) Then
Console.WriteLine("Found it: {0}", q)
End If
Next
This outputs:
This is a test ¶ for that char
Found it: 15

Word VBA code to cut numbers from one column and paste them in another

I am looking for some code that can search cell by cell in the 2nd column of a table for numbers and decimal points, cut them and paste them in the cell to the left whilst leaving the text behind.
For example:
1(tab space)Test
1.1(tab space)Test
1.1.1(tab space)Test
1.1.1.1(tab space)Test
Where the bullet points represent separate cells in different columns.
In all instances the numbers are separated from the text by a tab space "Chr9" (as indicated in the example)
Any help or useful snippets of code would much appreciated!
EDIT: I have some code that scans each cell in a column but I dont know the code to tell it to only cut numbers and decimal points up to the first tab space.
The Split function delivers what you are after. Sample code:
Dim inputString As String
Dim splitArray() As String
Dim result As String
inputString = "1 Test"
splitArray = Split(inputString, " ")
If(UBound(splitArray) >= 1) Then 'Making sure that it found something before using it
result = splitArray(1) 'Text
End If
inputString = "1.1 Test"
splitArray = Split(inputString, " ")
If(UBound(splitArray) >= 1) Then
result = splitArray(1) 'Text
End If
'etc.
UPDATE
Code delivering the functionality you want:
Dim splitArray() As String
Dim curTable As Table
Set curTable = ActiveDocument.Tables(1)
For Row = 1 To curTable.Rows.Count
With curTable
splitArray = Split(.Cell(Row, 2).Range.Text, " ")
If (UBound(splitArray) >= 1) Then
.Cell(Row, 2).Range.Text = splitArray(1)
.Cell(Row, 1).Range.Text = splitArray(0)
End If
End With
Next Row

VBA Word: Inserting Text Form Fields at a Specified Location

I am new to vba and developing a document that prompts the user to select a variable number of values from a combo box list. After selecting the values, I want to insert them in order onto the document itself as a Text Form Field. Let me show you how I generally am trying to get it to work.
First, the user selects values:
[a]
[b]
[c]
And selects an "OK" button. Then, I am attempting to add these selected values into the word document starting at a bookmark. Value "a" should be inserted followed by a space character followed by a blank Text Form Field, followed by two carriage returns. In the end the result should look something like this:
[bookmark]
[a]'_'[blank_a]'^p'
'^p'
[b]'_'[blank_b]'^p'
'^p'
[c]'_'[blank_c]'^p'
'^p'
Where [bookmark] is an invisible bookmark, '_' is a space, and '^p' is a carriage return. Currently my code is as follows:
Dim myRange As Range
Set myRange = ActiveDocument.Range(Start:=ActiveDocument.Bookmarks("START").Range.Start, _
End:=ActiveDocument.Bookmarks("END").Range.End)
For i = 1 To NUMBER_OF_RESPONSES
Selection.FormFields.Add(myRange, wdFieldFormTextInput).Name = "question_" & i
Selection.FormFields.Add(myRange, wdFieldFormTextInput).Result = "response_" & i
Next i
Naturally, there are no insertions of literal spaces or carriage returns yet as I have not figured out how to do it. The result of this code is as follows:
[START][blank_c][c][blank_b][b][blank_a][a][END]
I would like this order reversed and for there to be the aforementioned formatting inserted. Any pointers on how to go about doing it?
I am not sure if I have missed something, but why not relying on simple paragraphs instead on Bookmarks? Here you have a code doing what you want and any other thing (you can modify the ranges of the paragraphs to perform as complex actions as you wish).
Dim curRange As Range
Dim start_i As Integer
Dim end_i As Integer
Dim NUMBER_OF_RESPONSES As Integer
NUMBER_OF_RESPONSES = 3
start_i = NUMBER_OF_RESPONSES + 1 '0
end_i = 1 'NUMBER_OF_RESPONSES
Set curParagraph = ActiveDocument.Paragraphs.First
curParagraph.Range.Text = "[START]"
i = start_i
Do
If (start_i < end_i) Then
i = i + 1
Else
i = i - 1
End If
Set curParagraph = curParagraph.Range.Paragraphs.Add
curParagraph.Range.Text = "[question_" & i & "][" & "response_" & i & "]"
Loop While (i <> end_i)
Set curParagraph = curParagraph.Range.Paragraphs.Add
curParagraph.Range.Text = "[END]"
Solution
Well now I feel silly for asking the question. The solution was pretty simple.
ActiveDocument.Bookmarks("START").Select
For i = 1 To NUMBER_OF_RESPONSES
Selection.Font.Size = 11
Selection.Font.Bold = True
Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput) _
.Name = "question_" & i
Selection.Font.Bold = False
Selection.TypeText Text:=" "
Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput) _
.Name = "response_" & i
Selection.TypeParagraph
Selection.TypeParagraph
Next i
So the real issue was placing the cursor in the right location:
ActiveDocument.Bookmarks("START").Select
From there I was able to use Selection to insert the desired FormFields and characters.
This link was pretty helpful.
And if you are reading this because you also are new and trying to learn what to do, check out how to record a macro. It's a good first step. Record the macro, view the code it generated, and use that code to guide your own development. Cool.