I have to format a large document for a file that has been created from a PDF which is editable, so I know all the text is there.
The document is a series of tables. In Word the tables look pretty OK, but in some cases where there should be various cells there is just 1 and tabs have been used to align the text. So, it looks good, but if any of the text gets changed then the formatting will get messed up. I would like to have a macro that looks for cells with a tab, selects the cell, counts the number of tabs, divides the cell into the right number of cells and puts the text into the right cell. For example, a cell that contains "text 1 [tab]text 2[tab]text 3" would become 3 cells "text 1", "text 2" and "text 3".
I thought Word would be able to convert the text to a table, but when the text is already in a table it doesn't work.
If anyone has any suggestions as to how I might achieve this, then they would be much appreciated!
My main issue is not knowing how to count how many tabs are in a selection.
This function will return the number of Tabs in the given string.
Function CountTabs() As Integer
Dim Txt As String
Txt = "This is" & vbTab & "a test" & vbTab & "to count Tabs"
CountTabs = Len(Txt) - Len(Replace(Txt, vbTab, ""))
End Function
The tab character - Chr(9) - is replace with nothing and the number of tabs is the difference in character count before and after the replacement. Here is an implementation of the idea in a snippet.
Private Sub Snippet()
Dim Txt As String
Dim Count As Integer
Txt = "This is" & vbTab & "a test" & vbTab & "to count Tabs"
Count = Len(Txt) - Len(Replace(Txt, vbTab, ""))
MsgBox "There are " & Count & " tabs."
End Sub
Of course, how you get the text for the variable Txt is another story and, in the context of this forum, another question. Prophylactically, I advise against using the Selection object, however. Try to use the Range object instead.
Related
Got an issue where I want to select a text from one list box and add the text into another list box. the error only seems to happen if text has a "'" within the text and VBA seems to split the text and add the remaining text to the next column. Also, I'm working with column in my listbox and my code should add each text from left to right. This is fine but I need the whole text (including the ".") instead of the text being split up.
Private Sub btnAddUser_Click()
Dim SelectUser, ItemString1, ItemString2 As String, ItemString3 As String
For Each SelectUser In lstusers.ItemsSelected
Debug.Print lstusers.Column(0, SelectUser)
Debug.Print lstusers.Column(1, SelectUser)
Debug.Print lstusers.Column(2, SelectUser)
ItemString1 = lstusers.Column(0, SelectUser)
ItemString2 = lstusers.Column(1, SelectUser)
ItemString3 = lstusers.Column(2, SelectUser)
Form_frmAS.lstAddedUsers.AddItem ItemString1, 0
Form_frmAS.lstAddedUsers.AddItem ItemString2, 1
Form_frmAS.lstAddedUsers.AddItem ItemString3, 2
Form_frmAS.lstAddedUsers.Requery
Next SelectUser
End Sub
Is there a way to make it work or do I need to find a workaround?
Many Thanks
in the ListBox.AddItem method, the second parameter is the position in the list, i.e. the row number and not the column number. You cannot add the columns one by one.
To make it work, set the Row Source Type of the second ListBox to Value List and change the code to
For Each SelectUser In lstusers.ItemsSelected
lstAddedUsers.AddItem lstusers.Column(0, SelectUser) & ";" _
& lstusers.Column(1, SelectUser) & ";" _
& lstusers.Column(2, SelectUser)
Next
If you don't specify the second parameter in AddItem, the new item will automatically be appended at the end of the list.
I'm trying to manipulate some text from a MS Word document that includes hyperlinks. However, I'm tripping up at understanding exactly what Range.Start and Range.End are returning.
I banged a few random words into an empty document, and added some hyperlinks. Then wrote the following macro...
Sub ExtractHyperlinks()
Dim rHyperlink As Range
Dim rEverything As Range
Dim wdHyperlink As Hyperlink
For Each wdHyperlink In ActiveDocument.Hyperlinks
Set rHyperlink = wdHyperlink.Range
Set rEverything = ActiveDocument.Range
rEverything.TextRetrievalMode.IncludeFieldCodes = True
Debug.Print "#" & Mid(rEverything.Text, rHyperlink.Start, rHyperlink.End - rHyperlink.Start) & "#" & vbCrLf
Next
End Sub
However, the output between the #s does not quite match up with the hyperlinks, and is more than a character or two out. So if the .Start and .End do not return char positions, what do they return?
This is a bit of a simplification but it's because rEverything counts everything before the hyperlink, then all the characters in the hyperlink field code (including 1 character for each of the opening and closing field code braces), then all the characters in the hyperlink field result, then all the characters after the field.
However, the character count in the range (e.g. rEverything.Characters.Count or len(rEverything)) only includes the field result if TextRetrievalMode.IncludeFieldCodes is set to False and only includes the field code if TextRetrievalMode.IncludeFieldCodes is set to True.
So the character count is always smaller than the range.End-range.Start.
In this case if you change your Debug expression to something like
Debug.Print "#" & Mid(rEverything.Text, rHyperlink.Start, rHyperlink.End - rHyperlink.Start - (rEverything.End - rEverything.Start - 1 - Len(rEverything))) & "#" & vbCrLf
you may see results more along the lines you expect.
Another way to visualise what is going on is as follows:
Create a very short document with a piece of text followed by a short hyperlink field with short result, followed by a piece of text. Put the following code in a module:
Sub Select1()
Dim i as long
With ActiveDocument
For i = .Range.Start to .Range.End
.Range(i,i).Select
Next
End With
End Sub
Insert a breakpoint on the "Next" line.
Then run the code once with the field codes displayed and once with the field results displayed. You should see the progress of the selection "pause" either at the beginning or the end of the field, as the Select keeps "selecting" something that you cannot actually see.
Range.Start returns the character position from the beginning of the document to the start of the range; Range.End to the end of the range.
BUT everything visible as characters are not the only things that get counted, and therein lies the problem.
Examples of "hidden" things that are counted, but not visible:
"control characters" associated with content controls
"control characters" associated with fields (which also means hyperlinks), which can be seen if field result is toggled to field code display using Alt+F9
table structures (ANSI 07 and ANSI 13)
text with the font formatting "hidden"
For this reason, using Range.Start and Range.End to get a "real" position in the document is neither reliable nor recommended. The properties are useful, for example, to set the position of one range relative to the position of another.
You can get a somewhat more accurate result using the Range.TextRetrievalMode boolean properties IncludeHiddenText and IncludeFieldCodes. But these don't affect the structural elements involved with content controls and tables.
Thank you both so much for pointing out this approach was doomed but that I could still use .Start/.End for relative positions. What I was ultimately trying to do was turn a passed paragraph into HTML, with the hyperlinks.
I'll post what worked here in case anyone else has a use for it.
Function ExtractHyperlinks(rParagraph As Range) As String
Dim rHyperlink As Range
Dim wdHyperlink As Hyperlink
Dim iCaretHold As Integer, iCaretMove As Integer, rCaret As Range
Dim s As String
iCaretHold = 1
iCaretMove = 1
For Each wdHyperlink In rParagraph.Hyperlinks
Set rHyperlink = wdHyperlink.Range
Do
Set rCaret = ActiveDocument.Range(rParagraph.Characters(iCaretMove).Start, rParagraph.Characters(iCaretMove).End)
If RangeContains(rHyperlink, rCaret) Then
s = s & Mid(rParagraph.Text, iCaretHold, iCaretMove - iCaretHold) & "" & IIf(wdHyperlink.TextToDisplay <> "", wdHyperlink.TextToDisplay, wdHyperlink.Address) & ""
iCaretHold = iCaretMove + Len(wdHyperlink.TextToDisplay)
iCaretMove = iCaretHold
Exit Do
Else
iCaretMove = iCaretMove + 1
End If
Loop Until iCaretMove > Len(rParagraph.Text)
Next
If iCaretMove < Len(rParagraph.Text) Then
s = s & Mid(rParagraph.Text, iCaretMove)
End If
ExtractHyperlinks = "<p>" & s & "</p>"
End Function
Function RangeContains(rParent As Range, rChild As Range) As Boolean
If rChild.Start >= rParent.Start And rChild.End <= rParent.End Then
RangeContains = True
Else
RangeContains = False
End If
End Function
I have a template document in Word 2013 that has the user fill in a large number of Legacy Text FormFields. At the end of the document, I've included a button which compiles the answers into a string devoid of formatting, then copies it to the clipboard.
It works, but as each FormField is read, the Word document skips back and forth between each text field and the end of the document. It's visually alarming. Is there a way to gather the values of each FormField without Word moving the cursor/focus to each field as it is read?
Here's a sample of the code:
Private Sub cmdCreateNote_Click()
Call cmdClearNote_Click
Dim ff As FormFields
Set ff = ActiveDocument.FormFields
Dim Output As String
Output = ff("ddReviewType").Result & vbCrLf
If ff("chFacInfo").Result Then
Dim FacInfo
FacInfo = Array("Field1: ", _
"Field2: ", _
"Field3: ", _
"Field4: ", _
"Field5: ")
Output = Output & "FIRST SECTION" & vbCrLf
For Index = 1 To 5
If ff("chFacInfo" & Index).Result Then
Output = Output & FacInfo(Index - 1) & ff("txFacInfo" & Index).Result & vbCrLf
End If
Next
Output = Output & vbCrLf
End If
Dim FORange As Range
Set FORange = ActiveDocument.Bookmarks("FinalOutput").Range
FORange.Text = Output
ActiveDocument.Bookmarks.Add "FinalOutput", FORange
Selection.GoTo What:=wdGoToBookmark, Name:="FinalOutput"
Selection.Copy
End Sub
It appears that every time I access ActiveDocument.FormFields( x ).Result, the document focus goes to that element, then drops back to the end of the document again.
Any pointers?
Use the Bookmark object instead of the FormField. This will allow you to access the properties without changing the screen focus. See answer on Suppress unwanted jumping/scrolling on Word 2013 VBA Script for specifics on how to do this.
ActiveDocument.Bookmarks("myFieldName").Range.Fields(1).Result
Posting comment as answer, since it worked!
Try Application.ScreenUpdating = False before going through the FormFields and then setting it to True after, in order to minimize screen updating.
I have a multi-line textbox textbox1 and want to add the content to listbox1, but before each item I need to add "wordX=" where "X" is the item number.
Example of textbox1:
bob
gear
dog
etc.
Then listbox1 should have:
word1=bob
word2=gear
word3=dog
etc.
Currently I am using the line below to copy the textbox3 content to listbox1 but can't find how to add "word" and the proper number.
ListBox1.Items.AddRange(TextBox3.Text.Split(vbNewLine))
This is what I used to complete what you wanted.
Dim tbLines As String() = TextBox1.Text.Split(vbNewLine)
ListBox1.Items.Clear()
For i As Integer = 1 To tbLines.Length
ListBox1.Items.AddRange({"word" & i & "=" & tbLines(i - 1).Trim})
Next
I split the text box using the vbNewLine separator as you did. I then go through each index in that array to concatenate the string "word" with the i (current index) integer. I finish off with concatenating the "=" as well as the trimmed value in the listbox.
I'm using Excel to generate a summery report for my data. I want each summery to be displayed in a single cell. I used VBA and I got something like this:
I want to be able to display the data like this:
All the lines should start with "Increase" or "Decrease". How can I do it in VBA? (I have many cells like the one in this example) how to go over a text inside a specific cell and add a new line after each of these words?
If you are trying to fix the macro so it formats the lines correctly in future then you you need to add in a line feed (I use CrLf myself but Excel, for cells, only cares about the Line Feed) by concatenating the elements with vbLf.
My thanks to #retailcoder for pointing out that vbNewLine == vbCrLf, so you can use whichever makes more sense to you.
so something like Range.Value = "line 1" & vbcrlf & "line 2" & vbcrlf & "line 3" etc:
Range.Value = _
"line 1" & vbcrlf & _
"line 2" & vbcrlf & _
"line 3"
or, personally, I prefer to construct the text through a loop or using Join():
Range.Value = Join(Array( _
"Line 1", _
"Line 2", _
"Line 3"), vbCrLf)
For it to actually display on new lines, you need to double check that Word Wrap is on (Excel will set it on automatically but just in case it has been overridden by something else) using Range.WrapText = True
However, I realise an interpretation is that you just want to quickly fix what is already on the sheet. If this is the case then just manually do a Find and Replace of the word "Increase" or "Decrease" with Char(10)Increase or Char(10)Decrease respectively, where Char(10) is what you can get by pressing Alt+Numpad 0010, or by pasting in the value of the result from the formula =CHAR(10). Then remove the first character using a formula.