In MS Access VBA, I have been trying to programmatically insert code into a form's richtext textbox control when the user presses a button. The idea is to put a mark where the user's cursor is at the time the user presses the button--the mark will signify the start of text where the user enters a comment about the text.
However, presumably because the richtext textbox has hidden formatting codes embedded (e.g., <div>, etc.), using .SelStart and .SelLength does not seem to get me to the correct position in the textbox when I am trying to insert the new text. It is consistently inserting the text earlier in the textbox than where the cursor was when the button is clicked, but not a consistent number of characters earlier.
Although I've done a search and found some wonderful functions for inserting text into a standard textbox (e.g., Lebans' InsertAtCursor function), I cannot get those functions to work for richtext textboxes either--that is, they have the same problem as code that I wrote myself; it inserts the new text too early in the existing textbox text.
Anyone have a solution for programmatically inserting new text into a richtext textbox at the cursor position?
Here is code (obviously, I could make the code more efficient, but I was just trying to get something working first) from one of my attempts. It inserts text, but, not at the correct location, presumably due to the richtext formatting that does not visibly appear in the textbox but apparently influences .SelStart position values:
Dim intSelStart As Integer 'this is the starting location of the selection in the note at the time the comment was initially added
Dim strAddComment as String 'this is the string comment that I want to add--it is not the comment itself, it is a flag that will indicate the comment number
strAddComment = "|1`17|" 'the | characters delimit the comment flag; the first number is the comment number so 1 is the first comment, 2 is the second, etc.; the value after the ` is the length of the text selected in the textbox to which the comment applies, e.g., `17 means the comment applies to 17 selected characters
Forms!frmAppt_individual.SetFocus 'set the focus to the main form
Forms!frmAppt_individual.sub_C.SetFocus 'set the focus to the subform so we can get the .Sel property values of the text selected in the textbox on the subform
Forms!frmAppt_individual.sub_C.Form.Controls("Note").SetFocus 'set focus on the control which is required to get the .Sel property values
intSelStart = Forms!frmAppt_individual.sub_C.Form.Controls("Note").SelStart
'now try to insert the comment
Forms!frmAppt_individual.sub_C.Form.Controls("Note") = Left(Forms!frmAppt_individual.sub_C.Form.Controls("Note"), intSelStart) & strAddComment & Mid(Forms!frmAppt_individual.sub_C.Form.Controls("Note"), intSelStart + 1)
So, I am posting code below that worked for me to insert text at the current insertion point into a richtext textbox using VBA code. The use of the PlainText function seemed helpful. Hopefully the code below will help someone else trying to do the same thing.
An explanation of the code:
The function fAddComment is contained in a standard module. fAddComment is called when the user clicks a button btnAddComment on the parent form frmAppt. A subform subNoteForm contains the richtext textbox named tbxNote. The user is expected to have the insertion point at the position in the richtext textbox where the comment reference is inserted; the user may also have a number of characters selected that indicate the range of text to which the comment reference applies. The function fAddComment will determine what comment number the new comment reference will be by counting any existing comment references already in the note. The function will also count the number of characters selected when the comment reference is inserted so that a different function can later locate the comment reference and select the relevant characters. The function adds, at the insertion point, a comment emoji (💬), followed by the comment reference number, followed by a ` character, followed by the number of characters selected when the comment reference was added, ending with a terminating comment emoji. The function returns the string of the comment reference block that was added.
Public Function fAddComment() As String
'this is used to add a new comment reference to the currently showing note
'it returns "" if there is no note
'it returns the string of the comment reference added to the note if a comment reference is successfully added
Dim strBubble As String 'the comment bubble emoji string
strBubble = ChrW(55357) & ChrW(56492) 'the comment bubble emoji
Dim strProgNote As String
Dim intMaxComment As Integer 'this is the maximum comment number found
Dim intSelStart As Integer 'this is the starting location of the selection in the note at the time the comment was initially added
Dim intSelLength As Integer 'this is the selection length in the note at the time the comment was initially added
Dim whr As Integer 'this locates the next comment emoji and the emoji after it
Dim intFoundValue As Integer 'this is the value of the found comment number
Dim strNew As String 'the new string that holds the comment number and length
Dim strSelectedText As String 'the text that is selected
Dim intPosBeforeInsert As Integer 'the position of the insertion point prior to inserting the new comment reference
'first, get the text of the progress note
strProgNote = PlainText(Forms!frmAppt.subNoteForm.Form.Controls("tbxNote"))
If Len(strProgNote) = 0 Then 'there's no note, so don't try to find comments
fAddComment = ""
Exit Function
End If
'get the selection length at the time the comment was initially added
Forms!frmAppt.SetFocus 'set the focus to the main form
Forms!frmAppt.subNoteForm.SetFocus 'set the focus to the subform so we can get the length of the text selected in the textbox on the subform
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SetFocus 'set focus on the control which is required to get the SelLength property
intSelStart = Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelStart
intSelLength = Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelLength
strSelectedText = PlainText(Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelText)
'now, find each comment emoji string and get the value
intMaxComment = 0 'default to no comments
whr = 1
Do Until whr = 0
whr = InStr(whr, strProgNote, strBubble)
If whr > 0 Then 'found a comment, check the number
intFoundValue = Val(Mid(strProgNote, whr + 2)) 'the comment emoji consists of 2 characters, not just 1 character
If intFoundValue > intMaxComment Then intMaxComment = intFoundValue 'the new value is greater so make it the highest value now
whr = InStr(whr + 2, strProgNote, strBubble) + 2
End If
Loop
'return the next comment number and the length of the selected string in the note
strNew = strBubble & Trim(str(intMaxComment + 1)) & "`" & Trim(str(intSelLength)) & strBubble
'insert the new comment reference into the note
intPosBeforeInsert = Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelStart
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelLength = 0 'collapse selection
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelText = strNew 'insert the new comment text
'move the insertion point back to the original location and after the comment reference we just added
Forms!frmAppt.subNoteForm.Form.Controls("tbxNote").SelStart = intPosBeforeInsert + Len(strNew)
fAddComment = strNew 'return the comment string we just added to the note
End Function
Related
Is there any way to search only the first line of a Multiline Textbox without knowing exactly at what position the text is you're looking for?
If I knew the position of the text I was looking for I could do something like:
Dim myNotes As String = "The book has a lot of text"
Dim myText As String = "text"
If Not myNotes.Substring(0,4) = myText Then
' Do Something
End If
Or if I wanted to search the entire textbox I could do something like:
Dim myNotes As String = "The book has a lot of text"
Dim myText As String = "text"
If Not myNotes.Contains(myText) Then
' Do Something
End If
But I want to search only the first line of the textbox and I'm not sure at what position the text may be. Is there anyway to do a search like that?
This is another example of why you should ALWAYS read the relevant documentation. If you had read the documentation for the TextBox class then you'd know that it has a Lines property. To get the first line of text, you simply get the first element of that array:
Dim firstLine = myTextBox.Lines(0)
If Not filrstLine.Contains(myText) Then
'Do something
End If
Note that this only applies where the user has explicitly added a line break to the text. I assume that that is what you want, given that you have accepted another answer that does the same thing. If you mean the first line based on automatic word-wrap then that requires a bit more effort.
You could take the text and extract the first line.
int pos = text.IndexOfAny('\r', '\n');
if (pos >= 0)
text = text.SubString(0, pos);
// text now contains only the first line
Then you can search the resulting string.
I'm so close to getting this code working, I just need a little push please. I would like to
take the name of a combo box and then add a string to the end, But then get the value of a textbox with that string. This is to create a dynamic function instead of pasting the same code over and over.
Here's what I have so far, after you select something in the dropdown, the data is then pulled to populate the boxes next to it. I have about 8 drop downs so far so that's why I need this to work.
'Combobox after update
Call GrabData(Me, Me.ActiveControl)
Then
Private Sub GrabData(ctl As Control)
'name of ctl/combobox is "Kitchen"
data1 = (ctl.Name & "Size") '"KitchenSize"
'Here is where it all goes wrong
data1.Value = size.value
'size.value is just a textbox for example
End Sub
I can debug this with:
msgbox(data1)
'outputs "KitchenSize"
But I cannot get the value of kitchensize's textbox with data1.value
Error:
Object Required
I have also added Dim As String / Dim As Control.
I will be assigning the variable to some other stuff in this 50 line code I wrote so please don't take the above example as exactly what I intend to do, I just need help appending the ctl.name to a string, then use that to reference another control and so on.
EDIT
For anyone who wants to know, I figured it out.
Dim Ctrl As Control
Dim CtrlName As String
CtrlName = ctl.Name & "Size"
Set Ctrl = Me.Controls(CtrlName)
Ctrl.Value = 'Wherever you want to send the values to
See the edit.
You need to dim it as a string, then use Set Ctrl
Self taught(in progress) Visual Basic guy here.
I've searched for a clear answer on this, but so far have come up empty handed.
The problem...
I have two comboboxes. The first combobox has 10 options, second combobox has 2 options
I have 10 textboxes, with a name that includes one of the 10 options.
ex 1st textbox name - "txb_Option1Type"
2nd textbox name - "txb_Option2Type" and so on.
I have 2 tabs, with the first 5 text boxes on the 1st tab and last 5 on the 2nd tab.
I thought the following bit of code, upon a button click, would transfer the text of the chosen option in the 2nd combobox to the corresponding textbox...
`
Public Sub TransferTruckToDoorText()
Dim str_ErrorButton As String = cbx_DoorNumber.Text
Dim str_ReplaceSpacesButton As String = str_ErrorButton.Replace(" ", "")
Dim str_Button As String = str_ReplaceSpacesButton
' Null reference error on below line of code
Me.Controls("txb_" & str_Button & "Type").Text = cbx_TruckType.Text
End Sub
`
As noted in the above code, I'm getting a null reference and for the life of me cannot figure out why. I've stepped through the code, and I'm not able to find a NULL or Nothing value that could be making this catch.
Any and all help would be appreciated.
edited for clarity
The Me.Controls collection does not automatically search the child panels.
Try using the Controls.Find method for that, which includes a parameter to search the child control's control collection, too. It returns an array:
Dim c As Control() = Me.Controls.Find("txb_" & str_Button & "Type", True)
If c.Length = 1 Then
c(0).Text = cbx_TruckType.Text
End If
Me.Controls.Item("txb_" & str_Button & "Type")
I have a MultiLine TextBox that is updated over a period of time as an app runs, and I've managed to make it so that the TextBox scrolls to the bottom, ensuring that the latest entry is always shown.
However, sometimes the text is quite long and goes off of the side of the TextBox, so the Horizontal ScrollBar scrolls to the right.
How can I amend the code below so that the ScrollBar is always to the left, meaning that the beginning of lines is always visible? Please note that I do not wish to wrap text, as I can't have one entry on multiple lines. Thanks.
Private Sub UpdateCurrentProgress(ByVal Text As String)
If Text = "" Then Exit Sub
Dim Textbox As TextBox = Me.txtCurrentProgress
If Textbox.Text <> "" Then Text = vbCrLf & Text
Textbox.AppendText(Text)
Textbox.Select(Textbox.TextLength, 0)
Textbox.ScrollToCaret()
End Sub
You can select the first char at the current line like this:
Me.TextBox1.Select(Me.TextBox1.GetFirstCharIndexOfCurrentLine(), 0)
If I understand your problem correctly, then you need to get first the last line index and then select the first char of that line.
Dim lineNumber = textBox1.Lines.Count()-1
textBox1.Select(textBox1.GetFirstCharIndexFromLine(lineNumber), 0)
I have a ListView with two columns, and before enter a new item in the listview, I want to prevent entering a duplicate value, so I found ListView.FindItemWithText to accomplish that.
But I realized that if I enter 232323, and then enter 2323, which is different but starts with the same digits as the first entry, the function returns that item as a match.
I wonder if there is any way to match the whole text (exact text) to avoid the above.
Here is my code:
Dim ChkSIM As New ListViewItem
ChkSIM = lvItems.FindItemWithText("2323")
If Not ChkSIM Is Nothing Then
lblErrorSIM.Text = "Already in list"
End If
ListView.FindItemWithText has an overload to find only exact matches:
Dim ChkSIM As ListViewItem = lvItems.FindItemWithText("2323", True, 0, False)
For more information, see the documentation.