It there a simple direct way to move the insertion point to the end of a word in Word 2013? By end of the word, I mean the last character of the word is to the insertion point’s left, and the trailing space or punctuation is to the right, and nothing is selected. I’m convinced Word 2002 was able to do this without a macro. I’ve created the following macro to do this, but I’m convinced there has to be a built in way to do it, or at least the macro can be made simpler.
Sub MoveCursorEndWord()
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=1
If Selection.Text <> " " Then
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
End Sub
Actually, the procedure I came up with isn't so much different from yours at all.
Sub EndOfWord()
Dim Rng As Range
With Selection
.Words(1).Select
.Collapse wdCollapseEnd
Do While .Start
Set Rng = .Range
Rng.MoveStart wdCharacter, -1
If Asc(Rng.Text) = 32 Then
.Move wdCharacter, -1
Else
Exit Do
End If
Loop
End With
End Sub
The problem is that Word insists on including trailing spaces into its concept of a "word". Since you seem to follow a different definition there is a natural conflict.
Related
I am trying to move down one cell in a word table using VBA; the problem is when I use the unit:=wdCell it gives me a run-time error. I can use the default wdLine and it works fine, but if the cell has more than one line, I end up on the second line instead of the next cell.
With Selection
.MoveDown Unit:=wdCell, Count:=1, Extend:=wdMove
.Expand wdCell
.Range.Text = "Hello World"
End With
For some reason, you cannot use wdCell as a parameter to Move*, which does not appear to be a documented fact.
One workaround would be to jump to the end of the cell and then move one line down:
With Selection
.MoveEnd wdCell
.MoveDown wdLine, Count:=1
.Expand wdCell
End With
Another workaround would be to locate yourself in the table and jump to the next cell by index:
With Selection
Dim r As Long, c As Long
r = .Rows(1).Index
c = .Columns(1).Index
If .Rows(1).Parent.Rows.Count >= r + 1 Then
.Rows(1).Parent.Rows(r + 1).Cells(c).Range.Select
End If
End With
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.
Trying to join text of video caption into one paragraph, I want to delete all blank lines with 2 additional lines. For example:
1
00:00:04,350 --> 00:00:07,609
This tutorial will show how to seamlessly transfer
2
00:00:07,609 --> 00:00:11,059
a model from Revit structure to ETABS
etc, I would the result to be: This tutorial will show how to
seamlessly transfer a model from Revit structure to ETABS,...
My best try is and is giving incomplete results :(
Sub DelExpandEmpty()
Dim oPara As Word.Paragraph
Dim var
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range) = 1 Then
oPara.Range.Select
Selection.MoveDown unit:=wdLine, Count:=3
Selection.Expand wdLine
Selection.Delete
End If
Next
End Sub
I think it should be:
Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
I have the following piece of code (not mine) which adds a tab to every footnote in MS Word (2013).
The code works fine, but it would work even better if it didn't add a tab each time but it would simply replace first character (whatever it would be - tab, space) with a tab.
That way if the macro is run twice I didn't have two tabs, etc.
Sub TabFootnotes()
For s = 1 To ActiveDocument.Footnotes.Count
ActiveDocument.Footnotes(s).Range.Select
With Selection
.Collapse Direction:=wdCollapseStart
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.TypeText Text:=vbTab
End With
Next
End Sub
However you do this, you will have to come up with a way to determine if the first character is replaceable or not. This is because when you change that space to something else, this something becomes a part of the footnote's Range. So when the macro is run another time, you'll need to know if you must keep or replace the first character.
Dim f As Footnote
For Each f In ActiveDocument.Footnotes
With f.Range.Characters(1)
If .Text = vbTab Or .Text = " " Then 'Use any other sensible detection logic here
.Text = vbTab
Else
.InsertBefore vbTab
End If
End With
Next
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