How can I move the cursor to a postion where I want in office word by vb? - vba

12345qwesdfasdf22232 & 021930
Like the string above, I want to move the cursor to the position after the character & by searching the character in the string. How can I achieve it when I using visual basic to control the word?
Option Explicit
Dim WordApp As Word.Application
Private Sub Command2_Click()
Set WordApp = New Word.Application
WordApp.Documents.Open CommonDialog1.FileName
WordApp.Visible = True
WordApp.DisplayAlerts = False
...
End Sub

If you are outputting using Selection.TypeText, you can use
Selection.MoveStartUntil "&", wdBackward
Selection.MoveLeft 1
which will move you backwards until the first occurrence of the ampersand.
You can also do as Cindy Meister mentioned, do a Selection.Find similar to...
With Selection.Find
.MatchWildCards = false
.Text = "&"
.Execute
End With

Related

Update a FORMTEXT to a MERGEFIELD VBA

I have a project that I will likely be doing pretty regularly so I think a macro or vba module would be worth looking into.
The document has several [FORMTEXT] [FORMCHECKBOX] and such and I would like to automate replacing the [FORMTEXT] with {MERGEFIELD formtextname}. I've sone similar with {command} from Crystal to {mergefield } but that was just word replacement not field type. I found things about wdFormtextfield and wdMergeField just not sure how to .find type wdformtext. I assume if I can .find the type I can then .Replace with wdMergeField. I will be looping through the document. Any thoughts?
I might be going the wrong way but this is what I am thinking
Sub Change_FormTextToMergeField()
Application.ScreenUpdating = False
Dim StrFld As String 'change to a wd type for formtext
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "\{*\}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
End With
Do While .Find.Execute
i = 1
'add .Replace code to replace wdFieldFormTextInput with wdFieldMergeField
MsgBox .Words.Parent
i = i + 1
Loop
End With
Application.ScreenUpdating = True
End Sub
Sample Doc
The following procedure converts all FormFields to MergeFields perserving bookmarks as the Mergefield name
Sub FormFieldToMergeField() '
' A scratch Word macro coded by Charles Kenyon - based on Greg Maxey format
' https://stackoverflow.com/questions/75393869/update-a-formtext-to-a-mergefield-vba
' 2023-02-10
' started with Doug Robbins macro https://answers.microsoft.com/en-us/msoffice/forum/all/convert-formtext-fields-into-bookmarked-content/1f2d7aa2-a335-4667-9955-998d0525ba09
' Converts FormFields to Mail Merge Fields - the Bookmark name becomes the mergefield name
' If no FormField bookmark, then mergefield says Unnamed
'
' DECLARE VARIABLES / CONSTANTS
Dim oRng As range
Dim oFld As Field
Dim strName As String
Dim i As Long
'================================================
' ACTIONS
Application.ScreenUpdating = False
On Error GoTo lbl_Exit
With ActiveDocument
For i = .FormFields.Count To 1 Step -1
Set oRng = .FormFields(i).range
strName = .FormFields(i).Name
If strName = "" Then strName = "Unnamed Field " & i
.FormFields(i).Delete
oRng.Select
Set oFld = .Fields.Add(range:=oRng, Type:=wdFieldMergeField, Text:=strName)
Selection.Collapse wdCollapseStart
Next i
End With
' EXIT PROCEDURE
lbl_Exit:
' CLEAR ERROR HANDLER AND OBJECTS
Application.ScreenUpdating = True
Application.ScreenRefresh
On Error GoTo -1
Set oRng = Nothing
Set oFld = Nothing
Exit Sub
End Sub
If there is no bookmark, the mergefield will be to Unnamed.
Instructions for Installing Macros from Forums or Websites by Word MVP Graham Mayor

Replacing text in Word doc with text from Excel

I am looking to create a via script in excel that will replace a text holder in a word doc with some text from excel.
I can get the via script to open the word doc, and then save the doc under a new name. however it will not execute the replace text part :(
Private Sub CommandButton1_Click()
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
Set wdDoc = wdApp.Documents.Open("temp.docx")
With wdDoc.Content.Find
.ClearFormatting
.Text = "<<name>>"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "John Smith"
End With
.Execute Replace:=wdReplaceAll
End With
wdDoc.SaveAs2 Filename:=("temp2.docx")
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
I have tried doing a search in here but can't see where I am going wrong :(
currently it opens the word doc and saves it under a new name but does not replace the find and replace the text. Can anyone see where I have gone wrong and show me how to get it right?
When I set up a test for your problem description in Word, by typing <<name>> I see that Word replaces the two angled brackets with special symbols. And it offers the possibility to undo the AutoCorrect causing this.
Querying ASC(Selection.Text) on them gives Chr(171) and Chr(187), which are also double-angled bracket symbols, but using them in Find does not work. Querying AscW() reveals the two symbols are Unicode 8810 and 8811, so they need to be searched differently.
Assuming that's the issue in your case, the following works:
With wdDoc.content.Find
.ClearFormatting
.Text = ChrW(8810) & "name" & ChrW(8811) '"<<name>>"
With .Replacement
.ClearFormatting
.Font.Bold = True
.Text = "John Smith"
End With
.Execute Replace:=wdReplaceAll
End With
Further to your code - it has other, potentially grave problems (memory leak):
If you do this: wdApp.Visible = False then you need to be absolutely certain to remove Word from memory:
wdDoc.Close
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Unlike Excel, Word won't quit automatically when its object goes out of scope (macro ends). It will stay open, which you can see in the Task Manager.
In addition, you need to release the objects in the reverse order in which they were instantiated - wdDoc before wdApp.
Setup some DocVariables in your Word doc and run the code below, from within Excel.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
'On Error Resume Next
objWord.ActiveDocument.variables("BrokerFirstName").Value = Range("BrokerFirstName").Value
objWord.ActiveDocument.variables("BrokerLastName").Value = Range("BrokerLastName").Value
objWord.ActiveDocument.variables("Ryan").Value = Range("Ryan").Value
objWord.ActiveDocument.Fields.Update
'On Error Resume Next
objWord.Visible = True
End Sub
You can use essentially the same process by setting up Bookmarks in Word, and pushing data from fields in Excel to fields (Bookmarks) in Word.
Sub PushToWord()
Dim objWord As New Word.Application
Dim doc As Word.Document
Dim bkmk As Word.Bookmark
sWdFileName = Application.GetOpenFilename(, , , , False)
Set doc = objWord.Documents.Open(sWdFileName)
On Error Resume Next
ActiveDocument.Variables("BrokerFirstName").Value = Range("B1").Value
ActiveDocument.Variables("BrokerLastName").Value = Range("B2").Value
ActiveDocument.Fields.Update
On Error Resume Next
objWord.Visible = True
End Sub
The famouse hope - to have one button for all live cases with caption: "Make it OK!"
Do divide the task on parts:
- Get "... text from excel ..."
- "replace text in word doc ..." with text getted from Excel on previouse step
Do it by two separate procedures for each of tasks,
called from the third procedure united them.
.

How to search for symbols within a VBA Makro for Word

I´m new to VBA and have to write a little Makro for work.
This Makro will be used to search for a Special set of symbols inside a Word Document.
So far I found a way to search for a string and mark it.
Yet it only functions with normal chars. The question is how to include symbols into the search.
My code so far is:
With Selection.Find
.ClearFormatting
.Text = "String"
.Execute Forward:=True
End With
The symbol-string needed to be found inside the document is: [•]
Thank You for Your Suggestions
Something as easy as this works for me:
Public Sub Testme()
With Selection.Find
.ClearFormatting
.Text = "•"
.Execute Forward:=True
End With
End Sub
If this is the bullet format and not a simple dot in a text, then you may use something like this to select the bulleted paragraph:
Sub FindBullet()
Dim rngTarget As Word.Range
Dim oPara As Word.Paragraph
Set rngTarget = Selection.Range
With rngTarget
Call .Collapse(wdCollapseEnd)
.End = ActiveDocument.Range.End
For Each oPara In .Paragraphs
If oPara.Range.ListFormat.ListType = _
WdListType.wdListBullet Then
oPara.Range.Select
Exit For
End If
Next
End With
End Sub
Source here.

Use VBA with Powerpoint to Search titles in a Word Doc and Copy Text into another Word Document

I'm working on a Powerpoint slide, where I few texts are listed. I have to search for these texts in a Word Document which has a lot of Headings and Texts. After I find the title text, I need to copy the text under the Heading and paste in a new document.
Basically, the VBA coding has to be done in the Powerpoint VBA, with two documents in the background for searching text and pasting it in another.
I've opened the word doc. But searching the text in it and selecting it for copying to another document is what I've not been able to do. Kindly help me.
I see. The following is not exactly elegant since it uses Selection which I always try to avoid but it is the only way I know to achieve such a thing.
Disclaimer 1: this is made in Word VBA, so you will need a slight adaption, like set a reference to Word, use a wrdApp = New Word.Application object and declare doc and newdoc explicitely as Word.Document.
Disclaimer 2: Since you search for text instead of the respective heading, beware that this will find the first occurence of that text so you better not have the same text in several chapters. ;-)
Disclaimer 3: I cannot paste anymore! :-( My clipboard is set, it pastes elsewhere but I just cannot paste in here.
Code follows with first edit, hopefully in a minute...
Edit: yepp, pasting works again. :-)
Sub FindChapter()
Dim doc As Document, newdoc As Document
Dim startrange As Long, endrange As Long
Dim HeadingToFind As String, ChapterToFind As String
ChapterToFind = "zgasfdiukzfdggsdaf" 'just for testing
Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory
With Selection
With .Find
.ClearFormatting
.Text = ChapterToFind
.MatchWildcards = False
.MatchCase = True
.Execute
End With
If .Find.Found Then
'**********
'Find preceding heading to know where chapter starts
'**********
.Collapse wdCollapseStart
With .Find
.Text = ""
.Style = "Heading 1"
.Forward = False
.Execute
If Not .Found Then
MsgBox "Could not find chapter heading"
Exit Sub
End If
End With
.MoveDown Count:=1
.HomeKey unit:=wdLine
startrange = .Start
'*********
'Find next heading to know where chapter ends
'*********
.Find.Forward = True
.Find.Execute
.Collapse wdCollapseStart
.MoveUp Count:=1
.EndKey unit:=wdLine
endrange = .End
doc.Range(startrange, endrange).Copy
newdoc.Content.Paste
newdoc.SaveAs2 doc.Path & "\" & HeadingToFind & ".docx", wdFormatFlatXML
Else
MsgBox "Chapter not found"
End If
End With
End Sub
Edit: If you need to search for a "feature" that will be in some table in column 1 with the description in column 2 and you need that description in a new doc, try this:
Sub FindFeature()
Dim doc As Document, newdoc As Document
Dim FeatureToFind As String
Dim ro As Long, tbl As Table
FeatureToFind = "zgasfdiukzfdggsdaf" 'just for testing
Set doc = ActiveDocument
Set newdoc = Documents.Add
doc.Activate
Selection.HomeKey unit:=wdStory
With Selection
With .Find
.ClearFormatting
.Text = FeatureToFind
.MatchWildcards = False
.MatchCase = True
.Execute
End With
If .Find.Found Then
Set tbl = Selection.Tables(1)
ro = Selection.Cells(1).RowIndex
tbl.Cell(ro, 2).Range.Copy
newdoc.Range.Paste
End If
End With
End Sub
Edit: Slight adaptation so you can paste without overwriting existing content in newdoc:
Instead of newdoc.Range.Paste just use something along the line of this:
Dim ran As Range
Set ran = newdoc.Range
ran.Start = ran.End
ran.Paste

Find specific string in MS Word document and set a bookmark at that location

H ey folks,
I need to find a specific string (formatted as heading 1) in a MS Word document via Excel VBA and then set a bookmark at that location. The latter part shouldn't be a problem as soon as I've got the range of the searched string.
However, I can't seem to figure out how to search for a string in Word using Excel VBA.
I tried the following (shortened):
Option Explicit
Sub exportWord(button As IRibbonControl)
Application.ScreenUpdating = False
Dim wrdDoc As Word.document
Dim wrdApp As Word.Application
Dim wrdLoc As String
wrdLoc = ThisWorkbook.Worksheets("Konfiguration").Range("changelogPath")
Set wrdApp = New Word.Application
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open(wrdLoc)
Dim wrdRange As Word.Range
Dim searchString As String
Set wrdRange = wrdDoc.Range
searchString = "Test"
With wrdRange.Find
.Text = searchString
.Replacement.Text = "Replacement Test"
.wrap = wdFindContinue
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = False
.Execute Replace:=wdReplaceAll
End With
End Sub
This wouldn't actually do anything, but I just wanted to check of the finding works. It does not though and Excel just crashes without any VBA error or anything. Just says something amont of the lines of "Program not responding, the application has encountered a problem and will be closed down"
Does anyone have an idea why Excel would just crash without any proper error message? Or how to implemented a search in a Word document properly?
best regards,
daZza
Tried something different and solved it with:
For Each rngStory In wrdDoc.StoryRanges
With rngStory.Find
.Replacement.ClearFormatting
.Text = "Änderungen in Test12345"
.Replacement.Text = "test"
.wrap = wdFindContinue
.ExecuteReplace:=wdReplaceAll
End With
Next