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 !
Related
I'm trying to create a way for a word document to have certain textfields data to be replaced with other data. In my case, textfields are shown as a part of shapes and the textfields themselves don't have name's to them so I wanted to possibly do it by their shape ID. So for example I have a 5 Textboxes next to each other and say I want to edit the 4th textbox to say something since it's blank without affecting the other textboxes. What would I need to do?
Though Process: Because all the files have the same format, if I can figure out the id of that shape or textbox, I can directly reference that id and change the textfield that way. The text in the field is all random so I can't do a specific find word and replace so that's why I'm trying to do it by id or even just by having it do a count of the number of shapes on the page of a word document.
Tip: I turned on paragraph markers to see the textboxes more clearly.
Example of Code I've written so far:
Sub TextBox()
'find a specific textbox and edit it
Dim doc As word.Document, rng As word.Range
Dim shp As Shape, iShp As word.InlineShape
Set doc = ActiveDocument
Dim textbCount As String
Dim textbId As String
'textbCount = ActiveDocument.Shapes.Count
'textbId = oShape.ID
Dim sr As ShapeRange
Set sr = shp.TextFrame.TextRange.ShapeRange(5)
For Each shp In sr
If shp.ID = 0 Then
'oShape.TextFrame.TextRange.InsertAfter shp.ID
'shp.Delete
Debug.Print shp.Type
Debug.Print shp.ID
End If
Next shp
If ActiveDocument.Shapes.Count > 0 Then
For Each shp In ActiveDocument.Shapes
If shp.AutoShapeType = msoShapeRectangle Then
If shp.TextFrame.HasText = True Then
'shp.TextFrame.TextRange.GoToNext (wdGoToField)
'shp.Delete
'shp.Delete
shp.TextFrame.TextRange.InsertAfter textbCount
Exit For
End If
End If
Next shp
End If
End Sub
This is code you could use, I was able to just figure out the answer. What the code does is checks that the word document that you are trying to read is open and then it first checks to see if there are any shapes at all on the document which is the c > 0 because textboxes are categorized as shapes. Then it does a For Each loop going through all the shapes on the entire document and each shape has it's own unique identifier.
I already tested this for if templates that have the same format of textboxes, they will typically share the same identifier, so if you say have 2 word documents with each 20 textboxes and its a carbon copy of the other just with different text in the boxes almost like they took this blank document and then used it as the base template, it's highly likely that the ID's between the 2 documents are the same if opened separately, if they are combined into 1 document is when the ID's will change so that your not referencing the same data.
To continue on with the code, it will next check all the textboxes for a #, this can be changed out for anything, but for my case I wanted to find out which boxes by their ID I would be using since the word doc won't tell you, so because no where else on the document had #'s, I used those to find where the boxes were. Once you know the ID, you can just reference the boxes directly instead of using the #'s but you need to first know which ones have them.
Next the code will print to the "Immediate Window" which is like a debug window that you can open either in the view tab or by ctrl + G if your one windows and what it will print is the shape ID for each shape that has the # and then print whatever text is in that box which should include the # there along with whatever text is there in that box.
Now if you want to add text to the text box, I didn't include it in my example, or even replace the text. Just make an if statement for if shp.ID = 16 for example then inside that If Then statement say shp.TextFrame.TextRange.Text = "" or if you have a string you want to pass in, replace "" with whatever string that is and in the double quotes you can either leave that blank to make that textbox your referencing blank or you can put text in it to make it say something.
If your doing a project, like I was, and it requires checking a lot of these textboxes to reference the string to another textbox so basically one textbox determines the other. Use For Each shp In oShp a lot or your equivalent to that and check each ID and store it in a string variable and then do a separate For Each to reference those string variables to make new if statements or declarations since you you'll need to go through all the textboxes at least once to grab whatever data might be contained in them since it goes through the For Each sequence one at a time.
Dim shp As Shape
Dim oShp As Object
Dim doc As Document
Dim c As Integer
Dim objWord As Object
Dim objDoc As Document
'Set doc = ActiveDocument
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open("C:\Users\word.docx") 'Set this to wherever the word file is located along with the name of the word file so "C:\Users\worddoc.docx" is an example you could do
'Set objDoc = objWord.ActiveDocument
Set doc = objWord.ActiveDocument
Set oShp = doc.Shapes
c = ActiveDocument.Shapes.Count
'Set text1 = shp.TextFrame.TextRange
If c > 0 Then
For Each shp In oShp
If InStr(shp.TextFrame.TextRange.Text, "#") Then
Debug.Print shp.ID
Debug.Print shp.TextFrame.TextRange.Text
End If
Next shp
Debug.Print c
End If
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 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
i have a bunch of textboxes in a powerpoint slide.
They all contain text.
I need to sort those textboxes in order,
so i can loop through those textboxes,
capture the text,
and export it to a CSV file, IN ORDER, from top-left to bottom-right.
For example, if i have 4 textboxes in a slide, i need to capture text in
the textbox, in the order of
TOP-LEFT textbox
TOP-RIGHT textbox
BOTTOM-LEFT textbox
BOTTOM-RIGHT textbox
The part of the code (i got from internet) that exports the textbox's text to a CSV file works. Except that they are out of order.
Sub ExportTextToCSV()
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSld As Slide 'Slide Object
Dim oShp As Shape 'Shape Object
Dim sTempString As String
Dim Quote As String
Dim Comma As String
Dim myText As String
Dim myFilePath As String
myFilePath = ".\Export_Textbox.CSV"
Quote = Chr$(34)
Comma = ","
Set oPres = ActivePresentation
Set oSlides = oPres.Slides
For Each oSld In oSlides 'Loop thru each slide
For Each oShp In oSld.Shapes 'Loop thru each shape on slide
'Check to see if shape has a text frame and text
If oShp.HasTextFrame And oShp.TextFrame.HasText Then
myText = Replace(oShp.TextFrame.TextRange.Text, vbCr, vbCrLf)
sTempString = sTempString & Quote & myText & Quote & Comma
End If
Next oShp
'Add new line in CSV
sTempString = sTempString & vbCrLf
'Print the result to file:
Call WriteToTextFileADO(myFilePath, sTempString, "UTF-8")
'Clear the string
sTempString = ""
Next oSld
End Sub
Sub WriteToTextFileADO(filePath As String, strContent As String, CharSet As String)
Set stm = CreateObject("ADODB.Stream")
'if file exist, append
If Len(Dir(filePath)) > 0 Then
stm.Type = 2
stm.Mode = 3
stm.Open
stm.CharSet = CharSet
stm.LoadFromFile filePath
stm.Position = stm.Size
stm.WriteText strContent
stm.SaveToFile filePath, 2
stm.Close
Else
stm.Type = 2
stm.Mode = 3
stm.Open
stm.CharSet = CharSet
stm.WriteText strContent
stm.SaveToFile filePath, 2
stm.Close
End If
Set stm = Nothing
End Sub
According to stackoverflow's post "VBA For each - loop order", it says:
"A shape's position in the z-order corresponds to the shape's index
number in the Shapes collection."
I'm thinking of first creating and running a macro to re-set all the shapes z-order, base on "Top" and "Left" property of the textbox shape, before i run the ExportTextToCSV() macro.
I'm having trouble on using ShapeRange or Collection, to add reference to EXISTING SHAPES in a slide, and on sorting them base on their "Top" and "Left" property.
Please help. Thanks!
Create a disconnected recordset using ADO, populate it with textbox
name, text, top and left properties, then sort it by top then left
position. Use that to populate your text file. See for example:
developer.rhino3d.com/guides/rhinoscript/… – Tim Williams 23 hours ago
It worked. Thanks for pointing me in the right direction!
If you don't mind, please re-post your comment as an answer, so i can mark it as an answer.
I have a 400+ page coding manual I use, and unfortunately turned off the green for all the comments in the manual. I can't undo it, as I hadn't noticed it until it was too late. Its ruined years of work.
How would I write VBA to parse the document finding sentences starting with // and ending in a Paragraph mark and change the color of them? Or assign a style to them?
Here is a start that I have cobbled together, I admire people who can write code without intellisence, its like trying to find your way blindfolded
Dim oPara As Word.Paragraph
Dim rng As Range
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.text) > 1 Then
Set rng = ActiveDocument.Range(oPara.Range.Start,oPara.Range.End)
With rng.Font
.Font.Color = wdColorBlue
End With
End If
Next
End Sub
The following seems to work:
Dim oPara As Word.Paragraph
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
text = oPara.Range.text
'Check the left 2 characters for //
If Left(oPara.Range.text, 2) = "//" Then
oPara.Range.text = "'" & text
End If
Next
I assume you are using VBA so by placing a ' in front of // it will turn the line green. You could modify the code to replace // with ' if desired. The opera.range.text should grab the entire paragraph.