Example -
"Let this be the test sentence" , Suppose this line is selected , I need a Word macro to select only the first alphabet , that is 'L' and then format it in which ever way I want...
I am unable to get the macro to select only the first alphabet from the selected line.
I have tried this -
`'Selection.HomeKey Unit:=wdLine
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.Expand wdLine
MsgBox (Selection.Text)`
Can somebody please give me an answer to this
I assume you mean the first character in the selection?
MsgBox Selection.Characters(1)
Or, to use it to make that character bold:
Dim firstChar As Word.Range
Set firstChar = Selection.Characters(1)
firstChar.Bold = True
Option Explicit
Sub main()
Dim firstAlphabet As Range
Selection.SetRange Start:=0, End:=1 '<--| collapse Selection to its first character
Set firstAlphabet = Selection.Range
' now use 'firstAlphabet ' range for your formatting
End Sub
Related
I need to color text in a word document (code snippets) red up until the colon, then after the colon it needs to be blue until a comma or ending paren in each line (or selection).
I've been using "selection" and trying to use the move function to start up with the blue. But I'm new to VBA and all the tutorials are confusing to me as to how to tell it when to start and stop with specific formatting.
I found this that I thought might be a helpful bit, but when I put a comma in instead of a _ VB was unhappy with me.
Selection.MoveRight Unit:=wdCharacter, Count:=1, _
Extend:=wdExtend
If by each line you refer to paragraphs in word then the simple code may serve your purpose
Sub TestColorPara()
Dim Para As Paragraph, Rng As Range, ColonAt As Long, CommaAt As Long
For Each Para In Selection.Paragraphs
Ln = Para.Range.Characters.Count
If Ln > 1 Then
ColonAt = InStr(1, Para.Range.Text, ":")
If ColonAt > 0 Then
Set Rng = ActiveDocument.Range(Start:=Para.Range.Start, End:=Para.Range.Start + ColonAt)
Rng.Font.Color = wdColorRed
CommaAt = InStr(ColonAt, Para.Range.Text, ",")
CommaAt = IIf(CommaAt > 0, CommaAt, Ln - 1)
Set Rng = ActiveDocument.Range(Start:=Para.Range.Start + ColonAt, End:=Para.Range.Start + CommaAt)
Rng.Font.Color = wdColorBlue
End If
End If
Next
End Sub
Tested to achieve what I understand as your requirement.
I have a code like so:
Sub MoveToBeginningSentence()
Application.ScreenUpdating = False
Dim selectedWords As Range
Dim selectedText As String
Const punctuation As String = " & Chr(145) & "
On Error GoTo ErrorReport
' Cancel macro when there's no text selected
Selection.Cut
Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Set selectedWords = Selection.Range
selectedText = selectedWords
If InStr(selectedText, punctuation) = 0 Then
Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdMove
Selection.Paste
Else
Selection.MoveLeft Unit:=wdSentence, Count:=1, Extend:=wdMove
Selection.Paste
Selection.Paste
Selection.Paste
Selection.Paste
End If
ErrorReport:
End Sub
Basically, it help me move whatever text I have selected to the beginning of the sentence in Word. If there's no quotation mark, then paste once. If there is a quote mark, paste 4 times.
The problem is regardless of whether there's any quotation there or not, it will only paste once. If I set the macro to detect any other character, it will work fine. But every single time I try to force it to detect smart quotations, it will fail.
Is there any way to fix it?
Working with the Selection object is always a bit chancy; on the whole, it's better to work with a Range object. You can have only one Selection; you can have as many Ranges as you need.
Because your code uses the Selection object it's not 100% clear what the code does. Based on my best guess, I put together the following example which you can tweak if it's not exactly right.
At the beginning, I check whether there's something in the selection, or it's a blinking insertion point. If no text is selected, the macro ends. This is better than invoking Error handling, then not handling anything: If other problems crop up in your code, you wouldn't know about them.
A Range object is instantiated for the selection - there's no need to "cut" it, as you'll see further along. Based on this, the entire sentence is also assigned to a Range object. The text of the sentence is picked up, then the sentence's Range is "collapsed" to its starting point. (Think of this like pressing the left arrow on the keyboard.)
Now the sentence's text is checked for the character Chr(145). If it's not there, the original selection's text (including formatting) is added at the beginning of the sentence. If it's there, then it's added four times.
Finally, the original selection is deleted.
Sub MoveToBeginningSentence()
Application.ScreenUpdating = False
Dim selectedText As String
Dim punctuation As String
punctuation = Chr(145) ' ‘ "smart" apostrophe
Dim selRange As word.Range
Dim curSentence As word.Range
Dim i As Long
' Cancel macro when there's no text selected
If Selection.Type = wdSelectionIP Then Exit Sub
Set selRange = Selection.Range
Set curSentence = selRange.Sentences(1)
selectedText = curSentence.Text
curSentence.Collapse wdCollapseStart
If InStr(selectedText, punctuation) = 0 Then
curSentence.FormattedText = selRange.FormattedText
Else
For i = 1 To 4
curSentence.FormattedText = selRange.FormattedText
curSentence.Collapse wdCollapseEnd
Next
End If
selRange.Delete
End Sub
Please check out this code.
Sub MoveToBeginningSentence()
' 19 Jan 2018
Dim Rng As Range
Dim SelText As String
Dim Repeats As Integer
Dim i As Integer
With Selection.Range
SelText = .Text ' copy the selected text
Set Rng = .Sentences(1) ' identify the current sentence
End With
If Len(SelText) Then ' Skip when no text is selected
With Rng
Application.ScreenUpdating = False
Selection.Range.Text = "" ' delete the selected text
Repeats = IIf(IsQuote(.Text), 4, 1)
If Repeats = 4 Then .MoveStart wdCharacter, 1
For i = 1 To Repeats
.Text = SelText & .Text
Next i
Application.ScreenUpdating = True
End With
Else
MsgBox "Please select some text.", _
vbExclamation, "Selection is empty"
End If
End Sub
Private Function IsQuote(Txt As String) As Boolean
' 19 Jan 2018
Dim Quotes
Dim Ch As Long
Dim i As Long
Quotes = Array(34, 147, 148, -24143, -24144)
Ch = Asc(Txt)
' Debug.Print Ch ' read ASCII code of first character
For i = 0 To UBound(Quotes)
If Ch = Quotes(i) Then Exit For
Next i
IsQuote = (i <= UBound(Quotes))
End Function
The approach taken is to identify the first character of the selected sentence using the ASC() function. For a normal quotation mark that would be 34. In my test I came up with -24143 and -24144 (opening and closing). I couldn't identify Chr(145) but found MS stating that curly quotation marks are Chr(147) and Chr(148) respectively. Therefore I added a function that checks all of them. If you enable the line Debug.Print Ch in the function the character code actually found will be printed to the immediate window. You might add more character codes to the array Quotes.
The code itself doesn't consider spaces between words. Perhaps Word will take care of that, and perhaps you don't need it.
You need to supply InStr with the starting position as a first parameter:
If InStr(1, selectedText, punctuation) = 0 Then
Also
Const punctuation As String = " & Chr(145) & "
is going to search for space-ampersand-space-Chr(145)-space-ampersand-space. If you want to search for the smart quote character then use
Const punctuation As String = Chr(145)
Hope that helps.
I want to make a macro that will do the following:
Highlight every nth selection.
Check that selection to ensure it is a word (and not numerical or punctuation).
Cut the word and paste it into another document.
Replace the word with a blank space.
Repeat until the end of the document.
The hard part is checking a selection to validate that it is indeed a word and not something else.
I found some code written by someone else that might work, but I don't understand how to implement it in my macro with the rest of the commands:
Function IsLetter(strValue As String) As Boolean
Dim intPos As Integer
For intPos = 1 To Len(strValue)
Select Case Asc(Mid(strValue, intPos, 1))
Case 65 To 90, 97 To 122
IsLetter = True
Case Else
IsLetter = False
Exit For
End Select
Next
End Function
Sub Blank()
Dim OriginalStory As Document
Set OriginalStory = ActiveDocument
Dim WordListDoc As Document
Set WordListDoc = Application.Documents.Add
Windows(OriginalStory).Activate
sPrompt = "How many spaces would you like between each removed word?"
sTitle = "Choose Blank Interval"
sDefault = "8"
sInterval = InputBox(sPrompt, sTitle, sDefault)
Selection.HomeKey Unit:=wdStory
Do Until Selection.Bookmarks.Exists("\EndOfDoc") = True
Selection.MoveRight Unit:=wdWord, Count:=sInterval, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
If IsLetter = True Then
Selection.Cut
Selection.TypeText Text:="__________ "
Windows(WordListDoc).Activate
Selection.PasteAndFormat (wdFormatOriginalFormatting)
Selection.TypeParagraph
Windows(OriginalStory).Activate
Else
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
Loop
Loop
End Sub
The function should sit 'above' the rest of the code right? But I get an error 'argument not optional' when I run it.
Any ideas or tips much appreciated.
I think the code below will do most of what you want. Note that some of the comments relate to the reasons for which I discarded some of your code while others may prove helpful in understanding the present version.
Sub InsertBlanks()
' 02 May 2017
Dim Doc As Document
Dim WordList As Document
Dim Rng As Range
Dim Interval As String, Inter As Integer
Dim Wd As String
' you shouldn't care which Window is active,
' though it probably is the one you want, anyway.
' The important thing is which document you work on.
' Windows(OriginalStory).Activate
Set Doc = ActiveDocument
Application.ScreenUpdating = False
Set WordList = Application.Documents.Add
' If you want to use all these variables you should also declare them.
' However, except for the input itself, they are hardly necessary.
' sPrompt = "How many spaces would you like between each removed word?"
' sTitle = "Choose Blank Interval"
' sDefault = "8"
Do
Interval = InputBox("How many retained words would you like between removed words?", _
"Choose Blank Interval", CStr(8))
If Interval = "" Then Exit Sub
Loop While Val(Interval) < 4 Or Val(Interval) > 25
Inter = CInt(Interval)
' you can modify min and max. Exit by entering a blank or 'Cancel'.
' You don't need to select anything.
' Selection.HomeKey Unit:=wdStory
Set Rng = Doc.Range(1, 1) ' that's the start of the document
' Set Rng = Doc.Bookmarks("James").Range ' I used another start for my testing
Do Until Rng.Bookmarks.Exists("\EndOfDoc") = True
Rng.Move wdWord, Inter
Wd = Rng.Words(1)
If Asc(Wd) < 65 Then
Inter = 1
Else
Set Rng = Rng.Words(1)
With Rng
' replace Len(Wd) with a fixed number of repeats,
' if you don't want to give a hint about the removed word.
.Text = String(Len(Wd) - 1, "_") & " "
.Collapse wdCollapseEnd
End With
With WordList.Range
If .Words.Count > 1 Then .InsertAfter Chr(11)
.InsertAfter Wd
End With
Inter = CInt(Interval)
End If
Loop
Application.ScreenUpdating = True
End Sub
In order to avoid processing non-words my above code tests, roughly, if the first character is a letter (ASCII > 64). This will preclude numbers and it will allow a lot of symbols. For example "€100" would be accepted for replacement but not "100". You may wish to refine this test, perhaps creating a function like you originally did. Another way I thought of would be to exclude "words" of less than 3 characters length. That would eliminate CrLf (if Word considers that one word) but it would also eliminate a lot of prepositions which you perhaps like while doing nothing about "€100". It's either very simple, the way I did it, or it can be quite complicated.
Variatus - thank you so much for this. It works absolutely perfectly and will be really useful for me.
And your comments are helpful for me to understand some of the commands you use that I am not familiar with.
I'm very grateful for your patience and help.
I have VBA for Word that adds a button to the context menu of the right click which launches my application (which works).
I need the word clicked on to pass it as argument. I saw that I couldn't use Selection because right click doesn't select the word, it gives me the letter after the cursor.
With what I've read, I could possibly look at the position of the cursor, then look at both sides to where the word begins and finishes.
This seems to work
Selection.Words(1).Text
Edit
A little more robust to account for ends of sentences.
Sub FindWord()
Dim rWord As Range
If Selection.Words(1).Text = vbCr Then 'end of sentence
'get last word of sentence
Set rWord = Selection.Words(1).Previous(wdWord)
Else
'get selected word
Set rWord = Selection.Words(1)
End If
'There has to be a better way than this
If rWord.Text = "." Or rWord.Text = "?" Then
Set rWord = rWord.Previous(wdWord)
End If
Debug.Print rWord.Text
End Sub
Here is the most simple way to check for the word under the cursor.
Sub Sample()
Dim pos As Long
'~~> if the cursor is at the end of the word
Selection.MoveEnd Unit:=wdCharacter, Count:=1
Do While Len(Trim(Selection.Text)) = 0
'~~> Move one character behind so that the cursor is
'~~> at the begining or in the middle
Selection.MoveEnd Unit:=wdCharacter, Count:=-1
Loop
'~~> Expand to get the word
Selection.Expand Unit:=wdWord
'~~> Display the word
Debug.Print Selection.Text
End Sub
i'd like to write a macro that selects the next word to the right of the cursor, checks its spelling and replaces an error with the first suggestion..
can anyone with more VBA knowledge than me (..laugh) help out.
i tried the macro recorder but did not get any farther than this:
Sub FirstSuggest()
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
...
...
End Sub
thanks,
kay
Dim r As Range
Set r = Selection.GoToNext(wdGoToSpellingError)
With r.GetSpellingSuggestions()
If .Count > 0 Then
r.Text = .Item(1).Name
End If
End With