i want to replace some texts in the header area of my word file.
the actual replacement works, but it replaces all in Upper-case, no matter how the replacement text really looks like.
that's the code I use:
og = ""
vn = ""
nn = ""
tl = ""
fx = ""
getUserdatadata()
Dim tags As String() = {"XCDATEX", "XORGANIX", "XNAMEX", "XTELEX", "XFAXX"}
Dim name As String = vn + " " + nn
Dim replaces As String() = {Today.ToShortDateString, og, name, tl, fx}
worddoc.Application.ActiveWindow.ActivePane.View.Type = WdViewType.wdPrintView
worddoc.ActiveWindow.ActivePane.View.SeekView = WdSeekView.wdSeekFirstPageHeader
For i As Integer = 0 To 4
With worddoc.Application.Selection.Find
.Text = tags(i)
.Replacement.Text = replaces(i)
.Forward = True
.Wrap = WdFindWrap.wdFindContinue
.Execute(Replace:=WdReplace.wdReplaceOne)
End With
Next
for date, organisation, phone and fax there is no problem (organisation is fully in upper-case anyway).
But for the name, it always transforms the whole text to uppercase.
How to fix this?
found it:
I needed to add
.MatchCase = true
to the with statement
Related
I have 2 word documents:
Document to review for wrong words. Sample sentence in document: Winnie the poop is cute.
Document with a matrix that contains wrong words to search for, and a suggestion.
Example: Term=Winnie the poop Suggestion=Correct spelling is Winnie the pooh.
At this point my code adds a comment, but it highlights the whole sentence (Winnie the poop is cute). How do I link the suggestion to the specific term that is wrong (Winnie the poop)?
Sub Search4WrongWords()
Dim MatrixCounter As Integer 'Counter to search for all terms in the Matrix
Dim DocToValidate As Word.Document 'Document to validate and search for wrong words
Dim MaxWordsInMatrix As Integer 'Total rows in Matrix
Const ColumnWithTerm = 2 'Matrix wrong terms Example: Winnie the Poop
Const ColumnWithSuggestion = 3 'Matrix suggested term. Example: Winnie The Pooh
MatrixCounter = 0
DocumentPath = "C:\Folder\File_to_validate.docx" 'File to validate for wrong words
MatrixPath = "C:\Folder\Matrix_with_suggestions.docx" 'Matrix with terms & suggestions
Set MatrixDoc = Documents.Open(MatrixPath) 'File path is provided by user
Set DocToValidate = Documents.Open(DocumentPath) 'File path is provided by user
MaxWordsInMatrix = MatrixDoc.Tables(1).Rows.Count 'Total rows in matrix
For MatrixCounter = 2 To MaxWordsInMatrix 'counter =2 to avoid reading matrix header row
With DocToValidate.range.Find
.Text = Trim(LCase(Left(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).range.Text, Len(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).range.Text) - 2)))
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.NoProofing = False
Do While .Execute(Forward:=True) = True
suggestion = MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithSuggestion).range.Text
DocToValidate.Comments.Add DocToValidate.range, Text:=suggestion
Loop 'do while
End With 'DocToValidate
Next 'MatrixCounter
End Sub
When you execute a find the range, or selection, is redefined to the found match. This is useful if you are then going to further process the found range. In most circumstances it is possible to use the built-in range object of a document.
The exception to this is where you need to use the found range as an input parameter for another operation, as you do with adding a comment. In your code when you use DocToValidate.range as the anchor for the comment instead of referring to the found match it refers to the entire document.
You can overcome this by using an object variable for the range, as below.
Sub Search4WrongWords()
Dim MatrixCounter As Integer 'Counter to search for all terms in the Matrix
Dim DocToValidate As Word.Document 'Document to validate and search for wrong words
Dim MaxWordsInMatrix As Integer 'Total rows in Matrix
Const ColumnWithTerm = 2 'Matrix wrong terms Example: Winnie the Poop
Const ColumnWithSuggestion = 3 'Matrix suggested term. Example: Winnie The Pooh
MatrixCounter = 0
DocumentPath = "C:\Folder\File_to_validate.docx" 'File to validate for wrong words
MatrixPath = "C:\Folder\Matrix_with_suggestions.docx" 'Matrix with terms & suggestions
Set MatrixDoc = Documents.Open(MatrixPath) 'File path is provided by user
Set DocToValidate = Documents.Open(DocumentPath) 'File path is provided by user
MaxWordsInMatrix = MatrixDoc.Tables(1).Rows.Count 'Total rows in matrix
Dim findRange As Word.Range
Dim suggestion As String
For MatrixCounter = 2 To MaxWordsInMatrix 'counter =2 to avoid reading matrix header row
Set findRange = DocToValidate.Range 'necessary to ensure that the full document is being searched with each iteration
With findRange.Find
.Text = Trim(LCase(Left(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).Range.Text, Len(MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithTerm).Range.Text) - 2)))
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.NoProofing = False
.Wrap = wdFindStop 'stops find at the end of the document
Do While .Execute(Forward:=True) = True
'findRange has now been redefined to the found match
suggestion = MatrixDoc.Tables(1).Rows(MatrixCounter).Cells(ColumnWithSuggestion).Range.Text
DocToValidate.Comments.Add findRange, Text:=suggestion
findRange.Collapse wdCollapseEnd 'necessary to avoid getting into endless loop
Loop 'do while
End With 'findRange.Find
Next 'MatrixCounter
End Sub
I'm trying to delete string content before a certain word contained within the string. For example
master_of_desaster#live.de
I'd like to use VBA in order to replace that with
master_of_desaster
Everything after the "word" (#) should be removed, including the "word" itself.
I found a similar topic here, but he asks the opposite.
email = "master_of_desaster#live.de"
ret = Left(email, InStr(1, email, "#") - 1)
Result: master_of_desaster
Thanks to Shai Rado
=split("master_of_desaster#live.de","#")(0)
Just for fun - a regex approach.
Public Sub reg()
Dim re_pattern As String
Dim re As RegExp
Dim email As String
Dim match As Object
Set re = New RegExp
email = "master_of_desaster#live.de"
re_pattern = "(.*)#.*"
With re
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = re_pattern
End With
Set match = re.Execute(email)
Debug.Print match.Item(0).SubMatches(0)
End Sub
A bit hacky but fast ( most Windows API accept zero terminated strings )
ret = Replace("master_of_disaster#live.de", "#", vbNullChar, , 1) ' Chr(0)
I usually use the Split method but with Limit:
ret = Split("master_of_disaster#live.de", "#", 2)(0)
ret = evaluate("left(" & string & ", search(""#"", " & string & ") - 1)")
This code is translating all the words in a cell, but only the first should be forced to Proper case, the other words should keep the case written by the user, but instead it is forcing the first word to proper case and all the other words in the cell to lower case. All the other words should mantain its original case.
Sub TraAdd()
Dim translate As Object 'scritping.Dictionary
Set translate = CreateObject("Scripting.Dictionary")
translate("modens") = "modems"
translate("Modens") = "Modems"
translate("modens,") = "modems,"
translate("Modens,") = "Modems,"
translate("Fruteira,") = "Fruit bowl,"
translate("fruteira,") = "fruit bowl,"
translate("Fruteira") = "Fruit bowl"
translate("fruteira") = "fruit bowl"
translate("muletas") = "crutches"
translate("Muletas") = "Crutches"
translate("muletas,") = "crutches,"
translate("Muletas,") = "Crutches,"
Dim Words As Variant
Dim I As Integer
Words = Split(LCase(activecell.Value))
For I = LBound(Words) To UBound(Words)
If translate(Words(I)) <> "" Then Words(I) = translate(Words(I))
Next
activecell.Value = Join(Words)
activecell.Value = Ucase$(Left$(activecell.Value, 1)) & Right$(activecell.Value, Len(activecell.Value) - 1)
End Sub
Any ideas?
You have made all of your content lowercase when you split it into an array.
Remove LCase when you split the cell content to Words and it should work as you intend:
Words = Split(activecell.Value)
I have a list of full names in a column like for example:
Dave M. Butterworth
Dave M. Butterworth,II
H.F. Light jr
H.F. Light ,jr.
H.F. Light sr
Halle plumerey
The names are in a column. The initials are not limited to these only.
I want to extract the last name using a generic function. Is it possible?
Consider the following UDF:
Public Function LastName(sIn As String) As String
Dim Ka As Long, t As String
ary = Split(sIn, " ")
Ka = UBound(ary)
t = ary(Ka)
If t = "jr" Or t = ",jr" Or t = "sr" Or t = ",jr." Then
Ka = Ka - 1
End If
t = ary(Ka)
If InStr(1, t, ",") = 0 Then
LastName = t
Exit Function
End If
bry = Split(t, ",")
LastName = bry(LBound(bry))
End Function
NOTE:
You will have to expand this line:
If t = "jr" Or t = ",jr" Or t = "sr" Or t = ",jr." Then
to include all other initial sets you wish to exclude.You will also have to update this code to handle other exceptions as you find them !
Remove punctuation, split to an array and walk backwards until you find a string that does not match a lookup of ignorable monikers like "ii/jr/sr/dr".
You could also add a check to eliminate tokens based on their length.
Function LastName(name As String) As String
Dim parts() As String, i As Long
parts = Split(Trim$(Replace$(Replace$(name, ",", ""), ".", "")), " ")
For i = UBound(parts) To 0 Step -1
Select Case UCase$(parts(i))
Case "", "JR", "SR", "DR", "I", "II"
Case Else:
LastName = parts(i)
Exit Function
End Select
Next
End Function
I am fairly new to VBA. I tag text with heading styles in large documents from a variety of authors. Is it possible identify a number pattern on a line of bolded text, and apply the appropriate style to that entire line (there is usually a hard return at the end of the line).
For example, often our documents are numbered as shown below, and we tag the text accordingly.
1.0 text here (apply Heading 1)
1.2 text here (apply Heading 2)
1.2.1 text here (apply Heading 3)
1.2.1.1 text here (apply Heading 4)
2.0 text here (apply Heading 1)
2.2 text here (apply Heading 2)
….and so on
I have done a lot of research, but I am not sure if this is possible. We do not use any type of auto numbering.
Yes, it's possible. Try this code:
Sub ApplyHeadings()
Dim rg1 As Range
Dim rg2 As Range
Dim pos As Long
Dim i As Long
Dim dots As Long
Set rg1 = ActiveDocument.Range
With rg1.Find
.MatchWildcards = True
.Text = "[0-9.]{2,}[!^13]#[^13]"
.Wrap = wdFindStop
While .Execute
Set rg2 = rg1.Duplicate
dots = 0
' isolate the numbering
pos = InStr(rg2.Text, " ")
If pos > 0 Then rg2.End = rg2.Start + pos - 1
For i = 1 To Len(rg2.Text)
' count the dots in the number
If Mid(rg2.Text, i, 1) = "." Then dots = dots + 1
Next i
' apply correct heading level
Select Case dots
Case 1
If Mid(rg2.Text, 3, 1) = "0" Then
rg1.Style = ActiveDocument.Styles("Heading 1")
Else
rg1.Style = ActiveDocument.Styles("Heading 2")
End If
Case 2, 3 ' maybe more...
rg1.Style = ActiveDocument.Styles("Heading " & CStr(dots + 1))
Case Else
' do nothing
End Select
' prepare for next find
rg1.Collapse wdCollapseEnd
Wend
End With
End Sub