I have a macro that finds all of the 'Heading 1' styles within my document and lists them in a ComboBox on a UserForm.
My problem is that the Find routine I am using is also selecting the paragraph mark (ΒΆ) after the text I wish to copy, and that is being displayed in the ComboBox.
How can I remove this from the string? I've tried useing replace(), replacing vbCrLf, vbCr, vbLf, vbNewLine, ^p, v, Chr(244) and Asc(244) with "", but nothing has succeeeded. For example -
sanitizedText = Replace(Selection.Text, "^v", "")
Can anyone please help with this problem? Thanks.
Here is how my form looks -
You should use ChrW$() for unicode characters:
sanitizedText = Replace(Selection.Text, ChrW$(244), "")
Or, if the paragraph mark is always at the end maybe you can just remove the last character using
myString = Left(myString, Len(myString) - 1)
I used sanitizedText = Replace(Selection.Text, Chr(13), "") successfully; 13 is the ASCII value for 'carriage return'.
This tiny script replaces, in a piece of text selected in the document (i.e. marked using the cursor) hyphens that are at the beginning of a line. It replaces them by an improvised bullet point: (o)
The script searches for occurances of "Paragraph mark followed by hyphen".
I had a similar problem as in the question above, as I was sure paragraph marks should be 'Chr(13) & Chr(10)', which is equal 'VbCrLF', which is equal 'Carriage Return, Line Feed'. However, 'Chr(13) & Chr(10)' were wrong. The naked Chr(13) did the job.
Sub MakeAppFormListPoints()
'Replace list hyphens by (o)
Dim myRange As Range
Set myRange = Selection.Range 'What has been marked with the cursor
Debug.Print myRange ' Just for monitoring what it does
myRange = replace(myRange, Chr(13) & "-", Chr(13) & "(o)")
Debug.Print myRange ' Just for monitoring what it does
End Sub
(I use this for adjusting text written in Word to the insanely restricted character set of the official application form for the European Union Erasmus+ programme to promote lifelong learning activities. Well, I learned something.)
Related
Would appreciate some help with this problem.
I need to find all occurrences of a string in a Word document. When the string is found some complicated editing is performed on it. Sometimes no editing is needed and the string is left untouched. When all that is taken care of, I continue looking for the next occurrence of the string. Until the end of the document.
I wrote a routine to do that :
It starts by defining a Range (myRange) that covers the whole document.
Then a Find.Execute is performed.
When an occurrence is found I do the editing work.
Meanwhile myRange has been automatically redefined to cover only the found region (this is well documented in the VBA WORD documentation > FIND Object).
Then I redefine myRange to cover the portion of the text from the end of the previous found region down to the end of the text.
I iterate this until the end of the document.
This routine works well EXCEPT when an occurrence of the string is found in a TABLE. Then it is impossible to redefine myRange to cover the region from the end of the previous found down to the end of the text. In the redefinition VBA insists on including the previous found region (actually the whole TABLE). So when I iterate it keeps finding the same occurrence again and again and looping for ever.
What follows is a simplified version of my routine. It does nothing it is just to illustrate the problem. If you run it on a document where the string "abc" appears you will see it running happily to completion. But if your document has an occurrence of "abc" in a TABLE the routine loops for ever.
Sub moreTests()
Dim myRange As Range
Dim lastCharPos As Integer
Set myRange = ActiveDocument.Range
lastCharPos = myRange.End
myRange.Find.ClearFormatting
With myRange.Find
.Text = "abc"
End With
While myRange.Find.Execute = True
'An occurrence of "abc" has been found
MsgBox (myRange.Text)
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
'myRange has been redefined to encompass only the found region (the "abc" string)
'Perform whatever editing work is needed on the string myRange.Text ("abc")
'Now redefine myRange to cover the remainder of the document
myRange.Start = myRange.End
myRange.End = lastCharPos
MsgBox ("Range starts at : " & myRange.Start & "; Range ends at : " & myRange.End)
Wend
End Sub 'moreTests
I have several ways in mind to circumvent this problem. But none of them is simple, let alone 'elegant'. Does someone know if there is a 'standard' / 'proven' way of avoiding this problem ?
Many many thanks in advance.
I want to insert an if statement in a cell through vba which includes double quotes.
Here is my code:
Worksheets("Sheet1").Range("A1").Value = "=IF(Sheet1!B1=0,"",Sheet1!B1)"
Due to double quotes I am having issues with inserting the string. How do I handle double quotes?
I find the easiest way is to double up on the quotes to handle a quote.
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0,"""",Sheet1!A1)"
Some people like to use CHR(34)*:
Worksheets("Sheet1").Range("A1").Formula = "IF(Sheet1!A1=0," & CHR(34) & CHR(34) & ",Sheet1!A1)"
*Note: CHAR() is used as an Excel cell formula, e.g. writing "=CHAR(34)" in a cell, but for VBA code you use the CHR() function.
Another work-around is to construct a string with a temporary substitute character. Then you can use REPLACE to change each temp character to the double quote. I use tilde as the temporary substitute character.
Here is an example from a project I have been working on. This is a little utility routine to repair a very complicated formula if/when the cell gets stepped on accidentally. It is a difficult formula to enter into a cell, but this little utility fixes it instantly.
Sub RepairFormula()
Dim FormulaString As String
FormulaString = "=MID(CELL(~filename~,$A$1),FIND(~[~,CELL(~filename~,$A$1))+1,FIND(~]~, CELL(~filename~,$A$1))-FIND(~[~,CELL(~filename~,$A$1))-1)"
FormulaString = Replace(FormulaString, Chr(126), Chr(34)) 'this replaces every instance of the tilde with a double quote.
Range("WorkbookFileName").Formula = FormulaString
This is really just a simple programming trick, but it makes entering the formula in your VBA code pretty easy.
All double quotes inside double quotes which suround the string must be changed doubled. As example I had one of json file strings : "delivery": "Standard",
In Vba Editor I changed it into """delivery"": ""Standard""," and everythig works correctly. If you have to insert a lot of similar strings, my proposal first, insert them all between "" , then with VBA editor replace " inside into "". If you will do mistake, VBA editor shows this line in red and you will correct this error.
I have written a small routine which copies formula from a cell to clipboard which one can easily paste in Visual Basic Editor.
Public Sub CopyExcelFormulaInVBAFormat()
Dim strFormula As String
Dim objDataObj As Object
'\Check that single cell is selected!
If Selection.Cells.Count > 1 Then
MsgBox "Select single cell only!", vbCritical
Exit Sub
End If
'Check if we are not on a blank cell!
If Len(ActiveCell.Formula) = 0 Then
MsgBox "No Formula To Copy!", vbCritical
Exit Sub
End If
'Add quotes as required in VBE
strFormula = Chr(34) & Replace(ActiveCell.Formula, Chr(34), Chr(34) & Chr(34)) & Chr(34)
'This is ClsID of MSFORMS Data Object
Set objDataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObj.SetText strFormula, 1
objDataObj.PutInClipboard
MsgBox "VBA Format formula copied to Clipboard!", vbInformation
Set objDataObj = Nothing
End Sub
It is originally posted on Chandoo.org forums' Vault Section.
In case the comment by gicalle ever dies:
I prefer creating a global variable:
Public Const vbDoubleQuote As String = """" 'represents 1 double quote (")
Public Const vbSingleQuote As String = "'" 'represents 1 single quote (')
and using it like so:
Shell "explorer.exe " & vbDoubleQuote & sPath & vbDoubleQuote, vbNormalFocus
I'm writing a VBA script to generate word documents from an already defined template. In it, I need to be able to write headings along with a body for each heading. As a small example, I have a word document that contains only <PLACEHOLDER>. For each heading and body I need to write, I use the find-and-replace feature in VBA to find <PLACEHOLDER> and replace it with the heading name, a newline, and then <PLACEHOLDER> again. This is repeated until each heading name and body is written and then the final <PLACEHOLDER> is replaced with a newline.
The text replacing works fine, but the style I specify gets overwritten by the next call to the replacement. This results in everything I just replaced having the style of whatever my last call to my replacement function is.
VBA code (run main)
Option Explicit
Sub replace_stuff(search_string As String, replace_string As String, style As Integer)
With ActiveDocument.Range.Find
.Text = search_string
.Replacement.Text = replace_string
.Replacement.style = style
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub main()
Dim section_names(2) As String
section_names(0) = "Introduction"
section_names(1) = "Background"
section_names(2) = "Conclusion"
Dim section_bodies(2) As String
section_bodies(0) = "This is the body text for the introduction! Fetched from some file."
section_bodies(1) = "And Background... I have no issue fetching data from the files."
section_bodies(2) = "And for the conclusion... But I want the styles to 'stick'!"
Dim i As Integer
For i = 0 To 2
' Writes each section name as wsStyleHeading2, and then the section body as wdStyleNormal
Call replace_stuff("<PLACEHOLDER>", section_names(i) & Chr(11) & "<PLACEHOLDER>", wdStyleHeading2)
Call replace_stuff("<PLACEHOLDER>", section_bodies(i) & Chr(11) & "<PLACEHOLDER>", wdStyleNormal)
Next i
Call replace_stuff("<PLACEHOLDER>", Chr(11), wdStyleNormal)
End Sub
Input document: A word document with only <PLACEHOLDER> in it.
<PLACEHOLDER>
Expected Output:
I expect that each heading will be displayed in the style I specified and can be viewed from the navigation pane like this:
Actual Output: However what I actually get is everything as wdStyleNormal style like this:
I think the problem can be solved by inserting a paragraph break between every style transition, but when I try using vbCrLF or Chr(10) & Chr(13) or vbNewLine instead of the chr(11) I am using now, Each line begins with a boxed question mark like this:
Update from discussion in comments on another answer. The problem described below applies to Word 2016 and earlier. Starting in Office 365 (and probably Word 2019, but that's not been confirmed) the Replace behavior has been changed to "convert" ANSI 13 to a "real" paragraph mark, so the problem in the question would not occur.
Answer
The reason for the odd formatting behavior is the use of Chr(11), which inserts a new line (Shift + Enter) instead of a new paragraph. So a paragraph style applied to any part of this text formats the entire text with the same style.
In this particular case (working with Replace), vbCr or the equivalent Chr(13) also don't work because these are not really Word's native paragraph. A paragraph is much more than just ANSI code 13 - it contains paragraph formatting information. So, while the code is running, Word is not really recognizing these as true paragraph marks and the paragraph style assignment is being applied to "everything".
What does work is to use the string ^p, which in Word's Find/Replace is the "alias" for a complete paragraph mark. So, for example:
replace_stuff "<PLACEHOLDER>", section_names(i) & "^p" & "<PLACEHOLDER>", wdStyleHeading2
replace_stuff "<PLACEHOLDER>", section_bodies(i) & "^p" & "<PLACEHOLDER>", wdStyleNormal
There is, however, a more efficient way to build a document than inserting a placeholder for each new item and using Find/Replace to replace the placeholder with the document content. The more conventional approach is to work with a Range object (think of it like an invisible selection)...
Assign content to the Range, format it, collapse (like pressing right-arrow for a selection) and repeat. Here's an example that returns the same result as the (corrected) code in the question:
Sub main()
Dim rng As Range
Set rng = ActiveDocument.content
Dim section_names(2) As String
section_names(0) = "Introduction"
section_names(1) = "Background"
section_names(2) = "Conclusion"
Dim section_bodies(2) As String
section_bodies(0) = "This is the body text for the introduction! Fetched from some file."
section_bodies(1) = "And Background... I have no issue fetching data from the files."
section_bodies(2) = "And for the conclusion... But I want the styles to 'stick'!"
Dim i As Integer
For i = 0 To 2
BuildParagraph section_names(i), wdStyleHeading2, rng
BuildParagraph section_bodies(i), wdStyleNormal, rng
Next i
End Sub
Sub BuildParagraph(para_text As String, para_style As Long, rng As Range)
rng.Text = para_text
rng.style = para_style
rng.InsertParagraphAfter
rng.Collapse wdCollapseEnd
End Sub
The problem is caused by your use of Chr(11) which is a manual line break. This results in all of the text being in a single paragraph. When the paragraph style is applied it applies to the entire paragraph.
Replace Chr(11) with vbCr to ensure that each piece of text is in a separate paragraph.
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
So here's what I want to do:
I have a string origStr, which is at the beginning of a line in a Word document. After origStr is an unknown value (e.g. 23 or 2,6)
I want to find that string and replace the value after with another known value, but keep the string.
Example in my Word document:
Diam. diastole, mm: 53
[Running VBA makro where user input is 54,3]
Expected Result:
Diam. diastole, mm: 54,3
Actual result:
Diam. diastole, mm: 54,3 53
So here's what i got:
origStr = LArray(i, j - 1).Caption & ": *"
replStr = LArray(i, j - 1).Caption & ": " & TBArray(i, j).Text
With ActiveDocument.Content.Find
.MatchWildcards = True
.ClearFormatting
.Text = origStr
.Replacement.ClearFormatting
.Replacement.Text = replStr
.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
End With
Why isn't my old value being deleted?
Thanks in advance!
Word uses "lazy" pattern matching which is good in this case because otherwise it would just replace the rest of your entire document. Vincent G gave a solution for one word (no more than one space in the rest of the line), here is something more general:
To get Word to replace everything until the end of the line, you need to include the end of the line into the search string. ^l or ^11 is the control code for new line (shift+enter), ^12 is page or section break, ^13 is carriage return.
This is the most "recent" list I found.
So "yourtext*^11" would match everything from "yourtext" until the next new line and so on.
Depending on your formatting, it could be either one of the above so you have to be careful. If you replace "*^12" but your lines end with new line, you will replace the whole paragraph.
To catch all of them, you can group them: yourtext*[^11^12^13] will match everything until the next new line or carriage return. However if we replace that, the end of the line will be replaced as well so we have to include it in the replacement text. How do we know what it was?
We can use () to define a submatch and \1, \2 etc to use these submatches in the replacement text:
origStr = LArray(i, j - 1).Caption & ": *([^11^12^13])"
replStr = LArray(i, j - 1).Caption & ": " & TBArray(i, j).Text & "\1"
Example:
before:
after replacing with origStr = "yourtext*([^11^12^13])" and replStr = "yourtext newtext\1":
Note: These expressions also work with the Find and Replace dialog, just make sure "Use Wildcards" is enabled
Its not really a VBA problem, the same happening in "Find and Replace" dialog.
Replace your original string with:
origStr = LArray(i, j - 1).Caption & ": <*>"