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
Related
I am trying to get lines between two content controls in VBA for Word.
I want to set default line break between two content controls.
If it is more than two line breaks between I want to delete the others.
When doing my code in a loop, merging of strings into the content control makes multiple line breaks after merging into the content control.
How can I set default two line breaks between two content control?
Content control A
- line break
- line break
Content control B
I have find a solution for this.
Sub RemoveLineBreak()
Dim rStart As Range
Dim rEnd As Range
ActiveDocument.SelectContentControlsByTag("ContentC1").Item(1).Range.Select
Selection.MoveDown Unit:=wdLine, Count:=1
Set rStart = Selection.Range
ActiveDocument.SelectContentControlsByTag("ContentC2").Item(1).Range.Select
Selection.MoveUp Unit:=wdLine, Count:=1
Set rEnd = Selection.Range
ActiveDocument.Range(rStart.Start, rEnd.End).Select
Selection.Delete
Selection.InsertBreak Type:=wdLineBreak
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 have a word doc of several pages. There are many lines in the document that are short headings, then the carriage return, then a descriptive paragraph. Not front page news.
eg
Condition Subsequent
A condition subsequent is often used in a legal context as a marker bringing an end to one's legal rights or duties. A condition subsequent may be either an event or a state of affairs that must either (1) occur or (2) fail to continue to occur.
This sort of thing goes on down to the bitter end of the long document, with over 100 headings - that need to be underlined!
I have used this code to look for all lines less than 100 characters to underline, which works, but if the last line of a paragraph is less than 100 characters that also gets underlined, which I dont want:
Sub Underline_Header()
Dim numOfLines As Integer
numOfLines = ActiveDocument.BuiltInDocumentProperties("NUMBER OF LINES")
Selection.HomeKey Unit:=wdStory
For x1 = 1 To numOfLines
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
char_count = Len(Selection.Range.Text)
If char_count < 100 Then
Selection.Font.Underline = True
End If
Selection.MoveDown Unit:=wdLine, Count:=1
Next x1
End Sub
But when I try this (below) to look for paragraphs and count the number of characters in the paragraph, Word throws an error at the two lines highlighted below:
Sub Underline_Header()
Dim numOfParagraphs As Integer
numOfParagraphs = ActiveDocument.BuiltInDocumentProperties("NUMBER OF PARAGRAPHS")
Selection.HomeKey Unit:=wdStory
For x1 = 1 To numOfParagraphs
*>>Selection.HomeKey Unit:=wdParagraph
>>Selection.EndKey Unit:=wdParagraph, Extend:=wdExtend*
char_count = Len(Selection.Range.Text)
If char_count < 100 Then
Selection.Font.Underline = True
End If
Selection.MoveDown Unit:=wdParagraph, Count:=1
Next x1
End Sub
EDIT SOLUTION FOUND
For posterity ...
This code finds all paragraphs with less than 100 characters (assumes a heading) and underlines them:
Sub Underline_Header()
Dim numOfParagraphs As Integer
numOfParagraphs = ActiveDocument.BuiltInDocumentProperties("NUMBER OF PARAGRAPHS")
Selection.HomeKey Unit:=wdStory
For x1 = 1 To numOfParagraphs
Selection.Paragraphs(1).Range.Select
char_count = Len(Selection.Paragraphs(1).Range)
If char_count < 100 Then
Selection.Font.Underline = True
End If
Selection.MoveDown Unit:=wdParagraph, Count:=1
Next x1
End Sub
fwiw
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
I have a document with various headings (so not necessarily Heading 1 or Heading 2 - but all types of headings).
What I'm trying to do is write a macro that will, for example, delete 2 spaces at the end of each heading.
For example, we have
This is a heading
At the end of heading, I will do:
Selection.Delete Unit:=wdCharacters, Count:=2
I need this to be applied at the end of each heading.
Does anyone know how to do this?
Goto first heading:
Selection.GoTo What:=wdGoToHeading,Which:=wdGoToFirst
Goto next heading
Selection.GoTo What:=wdGoToHeading,Which:=wdGoToNext
Check where you are to see if you have reached the last heading:
x=Selection.Start
Selection.GoTo What:=wdGoToHeading,Which:=wdGoToNext
if x = Selection.Start then '... last heading reachd
Goto end of current heading (for example, to delete chars:
Selection.EndKey Unit:=wdLine