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
Related
I asked how to replace the space at the end of a line with a non-breaking space if the preceding character is a digit, throughout the document.
The code below makes my Word crash when it highlights the last line of the second last page of the document.
Dim myRange As Range
Set myRange = ActiveDocument.Range(ActiveDocument.Range.Start, ActiveDocument.Range.Start)
myRange.Select
Selection.Expand wdLine
While Selection.End < ActiveDocument.Range.End
If Right(Selection.Text, 1) = " " And IsNumeric(Left(Selection.Words.Last, 1)) = True Then
Selection.Characters.Last = Chr(160)
End If
Selection.MoveDown wdLine, 1
Selection.Expand wdLine
Wend
I suspect that you have your document in Print Layout view. Changing to Draft view enabled the code to run for me (O365).
Disabling screen updating will help prevent screen flashes and improve performance.
Because lines are of unequal length you also need to collapse the selection before moving it down a line otherwise some lines will get skipped.
Sub AddNonBreakingSpace()
Application.ScreenUpdating = False
'store current view type so it can be restored later
Dim viewType As WdViewType
viewType = ActiveWindow.View.Type
'change to Draft view to prevent crashing
ActiveWindow.View.Type = wdNormalView
Dim myRange As Range
Set myRange = ActiveDocument.Range(ActiveDocument.Range.Start, ActiveDocument.Range.Start)
myRange.Select
Selection.Expand wdLine
While Selection.End < ActiveDocument.Range.End
If Right(Selection.Text, 1) = " " And IsNumeric(Left(Selection.Words.Last, 1)) = True Then
Selection.Characters.Last = Chr(160)
End If
'collapse selection to avoid missing any lines
Selection.Collapse wdCollapseStart
Selection.MoveDown wdLine, 1
Selection.Expand wdLine
Wend
'restore original view
ActiveWindow.View.Type = viewType
Application.ScreenUpdating = True
End Sub
Trying to select and mark with red the specified text beginning from "Depend" to the end of the cell, but not the entire cell.
Sample of code:
With Selection
Set obj_Tbl = .Tables(1)
.Tables(1).Columns(2).Select ' Why so stupid? there is the conditional formatting
For Each obj_Row In obj_Tbl.Rows
With obj_Row.Cells(3)
If InStr(1, obj_Row.Cells(3), "Depend") > 0 Then
obj_Row.Cells(3).Range.Characters(InStr(1, obj_Row.Cells(3), "Depend")).Select
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Font.Color = RGB(192, 0, 0)
End If
End With
Next
End With
This works fine when the "Depend" is written in one row. But if the text looks like
Depends from Something
Too Long to Be Shown In One Line
I have the trouble with selection which selects only one row.
Selection.EndOf Unit:=wdParagraph 'selects the entire cell
Selection.EndKey Unit:=wdParagraph 'is not supported
You can use MoveRight and calculate the units to move right from Length of the Cell - Your Current Position.
Sub Test()
Dim count As Long
With Selection
Set obj_Tbl = .Tables(1)
.Tables(1).Columns(2).Select
For Each obj_Row In obj_Tbl.Rows
With obj_Row.Cells(3)
If InStr(1, obj_Row.Cells(3), "Depend") > 0 Then
obj_Row.Cells(3).Range.Characters(InStr(1, obj_Row.Cells(3), "Depend")).Select
count = Len(obj_Row.Cells(3).Range) - InStr(1, obj_Row.Cells(3), "Depend")
Selection.MoveRight Unit:=wdCharacter, count:=count - 2, Extend:=wdExtend
Selection.Font.Color = RGB(192, 0, 0)
End If
End With
Next
End With
End Sub
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.
I created this code to add found items enclosed with "[]" or "()" or "{}". If in my word document I have "ouch! [crying] That hurts! [crying] [laughing]" so the items enclosed with "[]" will be added to the listbox and there are 3 of it but the 2 are the same. I want to merge them.
How would I do that?
Sub cutsound()
Dim arrs, arrs2, c2 As Variant, pcnt, x2, x3, intItems as Integer
pcnt = ActiveDocument.Paragraphs.Count
arrs = Array("[", "(", "{")
arrs2 = Array("]", ")", "}")
UserForm1.Show False
Application.ScreenUpdating = False
With Selection
.WholeStory
For c2 = 0 To UBound(arrs)
.Find.Execute (arrs(c2))
Do While .Find.Found
.MoveEndUntil Cset:=arrs2(c2), Count:=wdForward
.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
UserForm1.ListBox1.AddItem Selection.Text
.MoveRight Unit:=wdCharacter, Count:=1
.EndKey Unit:=wdStory, Extend:=wdExtend
.Find.Execute
Loop
Next c2
End With
Application.ScreenUpdating = True
End Sub
Try to merge in a set rather then list, it maintains the duplication.
You could use the keys of a Dictionary to enforce uniqueness. Add a reference (Tools -> References...) to Microsoft Scripting Runtime. Then, do the following:
'I suggest searching using wildcards. The body of your loop will be much simpler
Dim patterns(3) As String, pattern As Variant
'Since these characters have special meaning in wildcards, they need a \ before them
patterns(0) = "\[*\]"
patterns(1) = "\(*\)"
patterns(2) = "\{*\}"
Dim rng As Range 'It's preferable to use a Range for blocks of text instead of Selection,
'unless you specifically want to change the selection
Dim found As New Scripting.Dictionary
For Each pattern In patterns
Set rng = ActiveDocument.Range
With rng
.WholeStory
.Find.Execute pattern, , , True
Do While .Find.found
found(rng.Text) = 1 'an arbitrary value
'If you want the number of times each text appears, the previous line could be modified
.Find.Execute
Loop
End With
Next
Dim key As Variant
For Each key In found.Keys
Debug.Print key
Next
Note: this code won't find entries in the order they appear in the document, but first entries with [], then with (), then with {}.
References:
Dictionary object
Find object
Range object
I can insert text before and after the selection using:
Selection.InsertBefore "start"
Selection.InsertAfter "end"
But I have no control over the style of the inserted text. How can I set the new, inserted text to a specific style (and leave the original selected text as it is)?
Below are two separate code to handle Insert After and Insert Before. Once you insert the text then depending on where is it inserted you have to select the inserted text and then change the style.
Sub InsertAfter()
Dim wrd As String
Dim rng As Range
wrd = "End"
Set rng = Selection.Range
rng.InsertAfter wrd
'~~> Remove selection. This will move the cursor at end of selected word
Selection.MoveRight Unit:=wdCharacter, Count:=1
'~~> Select the inserted word
Selection.MoveRight Unit:=wdCharacter, Count:=Len(wrd), Extend:=wdExtend
'~~> Change Style
Selection.Style = ActiveDocument.Styles("List Paragraph")
End Sub
Sub InsertBefore()
Dim wrd As String
Dim rng As Range
wrd = "Start"
Set rng = Selection.Range
rng.InsertBefore wrd
'~~> Remove selection. This will move the cursor at begining of inserted word
Selection.MoveLeft Unit:=wdCharacter, Count:=1
'~~> Select the inserted word
Selection.MoveRight Unit:=wdCharacter, Count:=Len(wrd), Extend:=wdExtend
'~~> Change Style
Selection.Style = ActiveDocument.Styles("List Paragraph")
End Sub
Here's a simple example:
Sub test()
Dim StartingCount As Long
Dim InsertBeforeCount As Long
With ActiveDocument
StartingCount = .Characters.Count
Selection.InsertBefore "start"
InsertBeforeCount = .Characters.Count - StartingCount
.Range(1, InsertBeforeCount).Font.Bold = True
Selection.InsertAfter "end"
.Range(StartingCount + InsertBeforeCount, .Characters.Count).Font.Italic = True
End With
End Sub