I'd want to indent RTF text in a RichTextBox without losing the RTF style.
Dim Alinea As String = " "
Private Sub Indent_Click(sender As Object, e As EventArgs) Handles Indent.Click
Try
Dim Output As String = Nothing
Dim Split() As String = RichTextBox1.Lines
For i = 0 To Split.Length - 1
Output = String.Concat(Output, Split(i).Insert(0, Alinea), If(Not i = Split.Length - 1, vbNewLine, Nothing))
Next
RichTextBox1.Text = Output
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
The previous code works, but it returns the text without any style.
I'd just like to add Alinea on all beginnings of line of the RichTextBox text.
I've tried to use the RichTextBox1.Rtf property, but it shows a MsgBox saying "File format not valid".
Instead of using RichTextBox1.Lines, use RichTextBox1.Rtf.
RichTextBox1.Rtf = RichTextBox1.Rtf.Replace(vbCrLf, vbCrLf & vbTab)
This works, but you may want to key on something like \par or \par & vbcrlf to adhere more to the rtf standard.
RichTextBox1.Rtf = RichTextBox1.Rtf.Replace("\par" & vbCrLf, "\par" & vbCrLf & vbTab)
"It is left as an exercise to the reader" to make it work on the first line and for any whitespace character following "\par". (I always hated that phrase.)
Related
I have a big table in ms-word that contains 85 contentcontrols (combo boxes). I want to change the content using a vba loop (see below). It takes longer than one minute for it to complete...
Are there other options?
Private Sub Btn_Clear1_Click()
Dim a
Dim c As ContentControl
a = FindTable(ActiveDocument.Name, "myTableName")(1) 'returns an array(Long) with number of table found
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
End Sub
Thanks in advance for any hint!
Here, turning off screenupdating reduces the time from about 6 seconds to less than 1 second. e.g.
On Error Goto turnscreenon
Application.Screenupdating = False
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
turnscreenon:
Application.Screenupdating = True
That may only work on the Windows version of Word.
If you know exactly how many combo boxes there are going to be, you could consider creating a custom xml part containing an array of XML Elements to contain the values. Map each content control to one of those elements. Then instead of writing the values to the content control ranges, write them to the XML Part and let Word do the work. That works almost instantaneously here.
e.g. in a simple scenario where you just have those 85 content controls in the table, you could set up the Custom XML Part like this (I leave you to write any code that you need to delete old versions). You should only need to run this once.
Sub createCxpAndLink()
' You should choose your own Uri
Const myNamespaceUri As String = "mycbcs"
Dim a
Dim i As Long
Dim s As String
Dim cxp As Office.CustomXMLPart
With ActiveDocument
a = FindTable(.Name, "myTableName")(1)
s = ""
s = s & "<?xml version='1.0' encoding='UTF-8'?>" & vbCrLf
s = s & "<cbcs xmlns='" & myNamespaceUri & "'>" & vbCrLf
For i = 1 To .Tables(a).Range.ContentControls.Count
s = s & " <cbc/>" & vbCrLf
Next
s = s & "</cbcs>"
Set cxp = .CustomXMLParts.Add(s)
With .Tables(a).Range.ContentControls
For i = 1 To .Count
.Item(i).XMLMapping.SetMapping "/x:cbcs[1]/x:cbc[" & Trim(CStr(i)) & "]", "xmlns:x='" & myNamespaceUri & "'", cxp
Next
End With
Set cxp = Nothing
End With
End Sub
Then to update the contents you need something like this
Sub testsetxml()
Const myNamespaceUri As String = "mycbcs"
Dim i As Long
'our start time...
Debug.Print Now
With ActiveDocument.CustomXMLParts.SelectByNamespace(myNamespaceUri)(1)
For i = 1 To 85
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text "
' or if you want to put different texts in different controls, you can test using e.g.
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text " & Cstr(i)
Next
End With
'our end time...
Debug.Print Now
End Sub
(NB you cannot do it by mapping all the controls to a single XML element because then all the dropdowns will all be updated to the same value whenever you change the value of one of them.)
Apologies for any typos - I've changed the code to be more in line with what you have already and have not tested the changes.
I'm currently building a form where a user can look up a tool based on the description or part number.
I want user to be able to type any letters into the combobox that I have tied to a query listing all my tools and the combobox will repopulate itself with the tools most similar to what is present in their combobox. For example, if they start typing wre, then tools that have similar characters will start appearing in the combobox such as wrench, torque wrench, power wrench, etc.
I've tried looking around for other people's solutions to this but either I didn't fully comprehend the existing solution (I'm fairly new to Access) or it wasn't what I was looking for. I've seen that people suggested using a listbox instead but I really don't want to go down that route.
I was thinking about using what the user types in the combobox and my VBA code will pick up the "change event" and requery the combobox on the fly by using their input as the like criteria for the new query.
Is this a possible route? Will it be slower? Is there a better route?
I'm hoping someone can show some examples on how to achieve what I'm looking for.
The search as you type feature is very useful! With a textbox and a listbox, you can setup a dynamic search tool that will filter a list for approximate matches as you type. The textbox has four events associated with it, as seen here.
The code behind the form looks like this. Pay attention to the part in bold. This is where we create a string of SQL commands, and utilize the SQL Like operator, to get dynamic matches as we type. Pay attention to the text in bold below.
Option Compare Database
Option Explicit On
Private blnSpace As Boolean 'INCLUDE THIS LINE ON YOUR FORM
Private Sub btnClearFilter_Click()
'CODE FOR THE RED "X" BUTTON TO CLEAR THE FILTER AND SHOW ALL
On Error Resume Next
Me.txtSearch.Value = ""
txtSearch_Change()
End Sub
Private Sub txtSearch_Change()
'CODE THAT HANDLES WHAT HAPPENS WHEN THE USER TYPES IN THE SEARCH BOX
Dim strFullList As String
Dim strFilteredList As String
If blnSpace = False Then
Me.Refresh 'refresh to make sure the text box changes are actually available to use
'specify the default/full rowsource for the control
strFullList = "SELECT RecordID, First, Last FROM tblNames ORDER BY First;"
'specify the way you want the rowsource to be filtered based on the user's entry
strFilteredList = "SELECT RecordID, First, Last FROM tblNames WHERE [First] LIKE ""*" & Me.txtSearch.Value &
"*"" OR [Last] LIKE ""*" & Me.txtSearch.Value & "*"" ORDER BY [First]"
'run the search
fLiveSearch Me.txtSearch, Me.lstItems, strFullList, strFilteredList, Me.txtCount
End If
End Sub
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
'NECESSARY TO IDENTIFY IF THE USER IS HITTING THE SPACEBAR
'IN WHICH CASE WE WANT TO IGNORE THE INPUT
On Error GoTo err_handle
If KeyAscii = 32 Then
blnSpace = True
Else
blnSpace = False
End If
Exit Sub
err_handle:
Select Case Err.Number
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & "(" & Erl() & ")"
End Select
End Sub
Private Sub txtSearch_GotFocus()
' USED TO REMOVE THE PROMPT IF THE CONTROL GETS FOCUS
On Error Resume Next
If Me.txtSearch.Value = "(type to search)" Then
Me.txtSearch.Value = ""
End If
End Sub
Private Sub txtSearch_LostFocus()
' USED TO ADD THE PROMPT BACK IN IF THE CONTROL LOSES FOCUS
On Error Resume Next
If Me.txtSearch.Value = "" Then
Me.txtSearch.Value = "(type to search)"
End If
End Sub
Finally, in a regular module, you will need this script.
Option Compare Database
Option Explicit On
'************* Code Start **************
' This code was originally written by OpenGate Software
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
' OpenGate Software http://www.opengatesw.net
Function fLiveSearch(ctlSearchBox As TextBox, ctlFilter As Control,
strFullSQL As String, strFilteredSQL As String, Optional ctlCountLabel As Control)
Const iSensitivity = 1 'Set to the number of characters the user must enter before the search starts
Const blnEmptyOnNoMatch = True 'Set to true if you want nothing to appear if nothing matches their search
On Error GoTo err_handle
'restore the cursor to where they left off
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
If ctlSearchBox.Value <> "" Then
'Only fire if they've input more than two characters (otherwise it's wasteful)
If Len(ctlSearchBox.Value) > iSensitivity Then
ctlFilter.RowSource = strFilteredSQL
If ctlFilter.ListCount > 0 Then
ctlSearchBox.SetFocus
ctlSearchBox.SelStart = Len(ctlSearchBox.Value) + 1
Else
If blnEmptyOnNoMatch = True Then
ctlFilter.RowSource = ""
Else
ctlFilter.RowSource = strFullSQL
End If
End If
Else
ctlFilter.RowSource = strFullSQL
End If
Else
ctlFilter.RowSource = strFullSQL
End If
'if there is a count label, then update it
If IsMissing(ctlCountLabel) = False Then
ctlCountLabel.Caption = "Displaying " & Format(ctlFilter.ListCount - 1, "#,##0") & " records"
End If
Exit Function
err_handle:
Select Case Err.Number
Case 91 'no ctlCountLabel
'exit
Case 94 'null string
'exit
Case Else
MsgBox "An unexpected error has occurred: " & vbCrLf & Err.Description &
vbCrLf & "Error " & Err.Number & vbCrLf & "Line: " & Erl()
End Select
End Function
The code comes from this link:
http://www.opengatesw.net/ms-access-tutorials/Access-Articles/Search-As-You-Type-Access.html
I am building language translator for my tribe. I have about 90% it completed. the only problem i am having is that i want to have msgbox pop up and say "translation not found.", when someone enters a phrase or a word that can't be found in the text file which is read " cat | nish stu yah." I can have it pop up when the translation isn't found, but here is the problem when i type in a word that is found the msgbox pop up as well. I dont know if it has to do with that it is running a do while (true) loop or i am just not coding the translator button correctly. the code is:
Do While (True)
Dim line As String = reader.ReadLine
If line Is Nothing Then
Exit Do
End If
Dim words As String() = line.Split("|")
Dim word As String
For Each word In words
If word = TextBox1.Text Then
TextBox2.Text = words(+1)
Else
MessageBox.Show("Translation is not available")
End If
If "" = TextBox1.Text Then
MessageBox.Show("No entry was made.")
End If
Next
Loop
Assuming your file format is:
cat | nish stu yah
with the spaces around the | character, your issue is probably that String.Split will not remove the spaces, so in this case you will end up with:
words(0) = "cat "
words(1) = " nish stu yah"
So, if TextBox1.Text is "cat", it will not match. You could change the comparison to something like this, to make it more forgiving:
If word.Trim().ToLower() = TextBox1.Text.Trim().ToLower() Then
However, you don't really need to loop through words, since you only want to compare the user input against the untranslated version. You are also showing the message box for each line in the translation file. I think you probably want something like this (completely untested):
If "" = TextBox1.Text Then
MessageBox.Show("No entry was made.")
Exit Sub
End If
Dim found As Boolean = False
Do While (True)
Dim line As String = reader.ReadLine()
If line Is Nothing Then
Exit Do
End If
Dim words As String() = line.Split("|"c)
If words(0).Trim().ToLower() = TextBox1.Text.Trim().ToLower() Then
TextBox2.Text = words(1)
found = True
Exit Do
End If
Loop
If Not found Then
MessageBox.Show("Translation is not available")
End If
Still not the most elegant code, but hopefully points you in the right direction.
I have a template document in Word 2013 that has the user fill in a large number of Legacy Text FormFields. At the end of the document, I've included a button which compiles the answers into a string devoid of formatting, then copies it to the clipboard.
It works, but as each FormField is read, the Word document skips back and forth between each text field and the end of the document. It's visually alarming. Is there a way to gather the values of each FormField without Word moving the cursor/focus to each field as it is read?
Here's a sample of the code:
Private Sub cmdCreateNote_Click()
Call cmdClearNote_Click
Dim ff As FormFields
Set ff = ActiveDocument.FormFields
Dim Output As String
Output = ff("ddReviewType").Result & vbCrLf
If ff("chFacInfo").Result Then
Dim FacInfo
FacInfo = Array("Field1: ", _
"Field2: ", _
"Field3: ", _
"Field4: ", _
"Field5: ")
Output = Output & "FIRST SECTION" & vbCrLf
For Index = 1 To 5
If ff("chFacInfo" & Index).Result Then
Output = Output & FacInfo(Index - 1) & ff("txFacInfo" & Index).Result & vbCrLf
End If
Next
Output = Output & vbCrLf
End If
Dim FORange As Range
Set FORange = ActiveDocument.Bookmarks("FinalOutput").Range
FORange.Text = Output
ActiveDocument.Bookmarks.Add "FinalOutput", FORange
Selection.GoTo What:=wdGoToBookmark, Name:="FinalOutput"
Selection.Copy
End Sub
It appears that every time I access ActiveDocument.FormFields( x ).Result, the document focus goes to that element, then drops back to the end of the document again.
Any pointers?
Use the Bookmark object instead of the FormField. This will allow you to access the properties without changing the screen focus. See answer on Suppress unwanted jumping/scrolling on Word 2013 VBA Script for specifics on how to do this.
ActiveDocument.Bookmarks("myFieldName").Range.Fields(1).Result
Posting comment as answer, since it worked!
Try Application.ScreenUpdating = False before going through the FormFields and then setting it to True after, in order to minimize screen updating.
i want to check a word file using vb.net and check that the styles in the document are proper or not.
I have to check for these expressions in word document
a.Verdana + 16 pt + Bold + Red
b.Verdana + 12 pt + Bold + Italic + Blue
c.Verdana + 11 pt + Bold + Italic + Brown
d.Arial + 10 pt + Black
I have tried this,
If objDoc.Range.Font.Name = "Arial" And objDoc.Range.Font.Size = 10 Then
If objDoc.Range.Font.Color = WdColor.wdColorBlack Then
End If
MsgBox("ok")
Else
MsgBox("not ok")
End If
But with this code it shows msgbox "OK" only when the whole word document consist of Arial,10,Black and shows msgbox "Not Ok" when it consist the above expressions except for the Arial,10,Black
So basically i need help to find out all the expressions in the same word document which consist of all the above expressions/Styles.
Any Help will be really really appreciable..
Plz help me with this still not able to find a solution..
With the foolowing code you can find sentences where font style is different.
Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim oDoc As New Word.Document()
Dim wapp As New Word.Application()
Try
oDoc = wapp.Documents.Open(TextBox1.Text & "\" & "TEST.doc")
For Each Senetence As Word.Range In oDoc.Sentences
For Each Character As Word.Range In Senetence.Characters
If Character.Font.Name <> "Verdana" AndAlso Character.Font.Name <> "Arial" Then
MsgBox(" Font Name not matching Error Line number " & Senetence.Text)
Exit For
End If
Next
Next
oDoc.Close()
Catch ex As Exception
oDoc.Close()
End Try
End Sub