I do have a userform in word which populates predefined bookmarks with values. I use following code to write the text to the bookmark:
Private Sub OKButton_Click()
Dim Text1 As Range
Set Text1 = ActiveDocument.Bookmarks("Text1").Range
Text1.Text = Me.ComboBox1.Value
When I hit the OK Button again, the text is added to the bookmark (and this can be done over and over again). This should not be possible. How can this be solved?
If the bookmark should only be written to once, I'd remove the bookmark when writing to it the first time. If the code runs again, this would cause an error, so check for the existence of the bookmark, first.
For example
Private Sub OKButton_Click()
Dim Text1 As Range
Dim doc As Document
Dim bkm As Bookmark
Dim bkmName As String
Set doc = ActiveDocument
bkmName = "Text1"
If doc.Bookmarks.exists(bkmName) Then
Set bkm = doc.Bookmarks(bkmName)
Set Text1 = bkm.Range
Text1.Text = "test" ' Me.ComboBox1.value
bkm.Delete
Else
Debug.Print "The bookmark has been removed."
End If
End Sub
Note that this approach assumes that the bookmark type is an "I-beam" type of bookmark: it marks a position in the document and contains no content.
If "bracket" bookmarks are used (the bookmark surrounds/contains at least one character) then the assigning text to the bookmark automatically deletes the bookmark. In that case, the line bkm.Delete is not required.
Usually, you would end an OK button sub with a command to close the userform, which discourages a second click:
Unload UserForm1
But if you want to make it impossible to add the text a second time, you would add a check of the existing text in the bookmark:
Private Sub OKButton_Click()
Dim Text1 As Range
Set Text1 = ActiveDocument.Bookmarks("Text1").Range
If Text1.Text <> Me.ComboBox1.value Then
Text1.Text = Me.ComboBox1.value
Else
MsgBox "That text has already been entered."
End If
End Sub
Related
Goal: Find headings in a document by their font and font size and put them into a spreadsheet.
All headings in my doc are formatted as Ariel, size 16. I want to do a find of the Word doc, select the matching range of text to the end of the line, then assign it to a variable so I can put it in a spreadsheet. I can do an advanced find and search for the font/size successfully, but can't get it to select the range of text or assign it to a variable.
Tried modifying the below from http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldn't figure out how to select and assign the found text to a variable. If I can get it assigned to the variable then I can take care of the rest to get it into a spreadsheet.
'A basic Word macro coded by Greg Maxey
Sub FindFont
Dim strHeading as string
Dim oChr As Range
For Each oChr In ActiveDocument.Range.Characters
If oChr.Font.Name = "Ariel" And oChr.Font.Size = "16" Then
strHeading = .selected
Next
lbl_Exit:
Exit Sub
End Sub
To get the current code working, you just need to amend strHeading = .selected to something like strHeading = strHeading & oChr & vbNewLine. You'll also need to add an End If statement after that line and probably amend "Ariel" to "Arial".
I think a better way to do this would be to use Word's Find method. Depending on how you are going to be inserting the data into the spreadsheet, you may also prefer to put each header that you find in a collection instead of a string, although you could easily delimit the string and then split it before transferring the data into the spreadsheet.
Just to give you some more ideas, I've put some sample code below.
Sub Demo()
Dim Find As Find
Dim Result As Collection
Set Find = ActiveDocument.Range.Find
With Find
.Font.Name = "Arial"
.Font.Size = 16
End With
Set Result = Execute(Find)
If Result.Count = 0 Then
MsgBox "No match found"
Exit Sub
Else
TransferToExcel Result
End If
End Sub
Function Execute(Find As Find) As Collection
Set Execute = New Collection
Do While Find.Execute
Execute.Add Find.Parent.Text
Loop
End Function
Sub TransferToExcel(Data As Collection)
Dim i As Long
With CreateObject("Excel.Application")
With .Workbooks.Add
With .Sheets(1)
For i = 1 To Data.Count
.Cells(i, 1) = Data(i)
Next
End With
End With
.Visible = True
End With
End Sub
I have a rich text content control called TestContent. Example:
In my code the sub RunExample initialized the range of said content control and writes the example text into the end of the range using AddText sub:
Option Explicit
Dim TestContentRange As Word.Range
Sub RunExample()
'Initialize the range as the range of Content Control
Set TestContentRange = ActiveDocument.SelectContentControlsByTitle("TestContent")(1).Range
'Write the "Hello World" to the content Control
AddText "Hello World"
End Sub
Sub AddText(TextBit As String)
Dim SlaveRange As Word.Range
Set SlaveRange = TestContentRange
SlaveRange.Collapse Direction:=wdCollapseEnd
SlaveRange.Text = TextBit
End Sub
I get Runtime error 6124 : You are not allowed to edit this selection because it is protected.
As I understand the reason for this is because when the content control is empty the placehorlder text gets in the way. And the placeholder is prohibited from direct editing hence the error. For example if I put some text into the Content Control like TestContentRange.Text = "!" the code runs fine. Example:
Option Explicit
Dim TestContentRange As Word.Range
Sub RunExample()
Set TestContentRange = ActiveDocument.SelectContentControlsByTitle("TestContent")(1).Range
TestContentRange.Text = "!"
AddText "Hello World"
End Sub
Sub AddText(TextBit As String)
Dim SlaveRange As Word.Range
Set SlaveRange = TestContentRange
SlaveRange.Collapse Direction:=wdCollapseEnd
SlaveRange.Text = TextBit
End Sub
My question is - how do I avoid that placeholder text? Should I make a check of the range being empty in the AddText sub or is there a better way?
My understanding of your question is that you want to either replace or add to the text of a content control, depending on the existing text in the control.
To check if a content control still contains its placeholder text simply compare the controls Range.Text to its PlaceholderText property. To do that your AddText routine needs to work with the actual content control not just its range.
Sub RunExample()
AddTextToContentControl ActiveDocument, "Test Content", "Hello World"
End Sub
Sub AddTextToContentControl(WorkDoc As Document, CCTitle As String, TextToAdd As String)
Dim ctrl As ContentControl
Set ctrl = GetContentControlByTitle(WorkDoc, CCTitle)
If Not ctrl Is Nothing Then
If ctrl.Range.Text = ctrl.PlaceholderText Then
'replace the placeholder text
ctrl.Range.Text = TextToAdd
Else
'add to the existing text
ctrl.Range.Text = ctrl.Range.Text & " " & TextToAdd
End If
End If
End Sub
Function GetContentControlByTitle(SearchDoc As Document, CCTitle As String) As ContentControl
Dim ctrl As ContentControl
For Each ctrl In SearchDoc.ContentControls
If ctrl.Title = CCTitle Then
Set GetContentControlByTitle = ctrl
Exit For
End If
Next
End Function
Because you're collapsing the range, the macro tries to append your text to the default text in the CC, which is not possible. Just take out this line:
SlaveRange.Collapse Direction:=wdCollapseEnd
Then it runs as expected and replaces the default.
I suggest something that makes use of .ShowingPlaceholderText, e.g. :
' This assumes there is at least one CC titled "TestContent"
With ActiveDocument.SelectContentControlsByTitle("TestContent")(1)
If .ShowingPlaceholderText Then
.Range.Text = "Hello World"
Else
.Range.InsertAfter "Hello World"
End If
End With
Otherwise, a design problem occurs if the CC currently contains text that is identical to the placeholder text. Do you want text that is identical to the placeholder text, but is real text, to be replaced as if it was actually placeholder text, or do you want to append "Hello World" ?
I have a userform with a bunch of checkboxes. I want the VBA code to add a block of text (defined as a variable) if the checkbox is true and remove that block of text if it gets unchecked. As an example, this is what I have for one of the checkboxes:
Private Sub CheckBox1_Click()
Dim Text1 As String
Text1 = "Text test"
If CheckBox1.Value = True Then
Selection.TypeText Text:=Text1
Selection.InsertParagraph
End If
If CheckBox1.Value = False Then
Selection.Delete Text:=Text1
End If
End Sub
First of all, the Selection.Delete Text:=Text1 part is completely wrong. I've tried to google something similar and have been unable to find anything that deletes the content of a variable.
Second of all, there seems to be an error with the Selection.InsertParagraph code. I want it to add a new paragraph between each block of text/variable, however with the way that the code is now, it adds the text block and the paragraphs separately like this if I were to activate the macro 3 times:
Text testText testText test
(new paragraph)
(new paragraph)
(new paragraph)
What I want instead is this:
Text test
(new paragraph)
Text test
(new paragraph)
Text test
(new paragraph)
Answering the first question, for which there is sufficient information to provide an answer...
The best control of where something is inserted and foramtted in a Word document is to use Range objects. There can be only one Selection, but code can work with multiple Ranges.
For inserting a new paragraph immediately following text it's possible to append the new paragraph at the end of the text using the ANSI 13 character, which can be represented in VBA code using vbCr.
Example:
Private Sub CheckBox1_Click()
Dim Text1 As String
Dim rngTarget as Range
Text1 = "Text test"
Set rngTarget = Selection.Range
If CheckBox1.Value = True Then
rngTarget.Text = Text1 & vbCr
End If
'
'If CheckBox1.Value = False Then
' Selection.Delete Text:=Text1
'End If
'''Move to the end of the range and select that for the next iteration
rngTarget.Collapse wdCollapseEnd
rngTarget.Select
End Sub
i have a userform with a multiline textbox for the Adress in the format
Name1 Name2
Street Number
ZIP Place
Now i want to get the first line with the name to be bold. I have created a textbox in my UserForm which fills the textmark but i cant get it working that just the first line is bold and the rest just normal i just get it working that the whole textbox is bold.
Private Sub CommandButton1_Click()
Dim rngDoc As Range
Dim oDoc As Document
Dim cText As String
Dim oRng As Range
Dim oBM As Bookmark
Set oDoc = ActiveDocument
cText = TextBox5.Text
With oDoc
If .Bookmarks.Exists("Adresse") Then
Set oRng = .Bookmarks("Adresse").Range
oRng.Text = cText
Set oBM = .Bookmarks.Add(Name:="Adresse", Range:=oRng)
.Bookmarks("Adresse").Range.Paragraphs(1).Range.Font.Bold = True
End If
End With
End Sub
Fixxed my problem.
The first line in my text bookmark was already bold (marked it when i entered the text manually) thats why the code wasnt working and everything was getting bold. The code above is working and just making the first line bold which is entered in the text field !
I want a way of updating all the fields on a document automatically. I currently have a macro which is linked to F9. This macro updates all the fields in the header and footer, as well as all the ones in the main document.
Sub UpdateFields()
Dim oStory As Range
For Each oStory In ActiveDocument.StoryRanges
oStory.Fields.Update
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Fields.Update
Wend
End If
Next oStory
Set oStory = Nothing
End Sub
Apart from setting the macro on every key, how would I make it so this macro runs when the user types anything?
For example a user may place a field in the footer or header which shows the amount of characters. If this was the case I would like to be able to see the characters field update as I type.
Here are the events in Word VBA :
For the application :
https://msdn.microsoft.com/EN-US/library/office/dn320473.aspx
For the document :
https://msdn.microsoft.com/EN-US/library/office/dn320613.aspx
I would suggest that you use the Application.WindowSelectionChange event (Occurs when the selection changes in the active document window) : https://msdn.microsoft.com/EN-US/library/office/ff192791.aspx
Public WithEvents appWord As Word.Application
Private Sub appWord_WindowSelectionChange(ByVal Sel As Selection)
UpdateFields
End Sub
And if you need more details on that, you'll find some here : https://msdn.microsoft.com/library/office/ff746018.aspx