We get a lot of these documents in, despite attempts to instruct people
to indent properly, use styles etc.
I wondered if anyone could point me in the right direction of a macro
that would take the current paragraph, and replace any occurrence of a
tab, after the first one, with a blank space, then hanging-indent the
whole paragraph to the first tab marker (or 0.5 inch if not existing).
So in other words take the unwanted Tabs out and indent the paragraph
properly, like we currently have to do manually.
My command of VBA is not that advanced. Is there such a thing as
FOREACH Tab in Paragraph....?
like this, which may not look too elegant,
but without knowing more about
the structure of your doc and whatever
your amateur typists are doing,
I thought, you may be on the safe side
with this code.
Sub Test0001()
ActiveDocument.Range(0, 0).Select
' cursor to start of doc
Do
With Selection.Bookmarks("\line").Range
If .Characters.First = Chr(9) Then
.Characters.First.Delete
End If
' check for end of doc
If .Characters.Last.End + 1 = _
ActiveDocument.Range.End Then
Selection.WholeStory
With Selection.Range.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.63)
.FirstLineIndent = CentimetersToPoints(-0.63)
.TabStops.ClearAll
.TabStops.Add _
Position:=CentimetersToPoints(0.63), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
End With
Exit Sub
End If
End With
With Selection
.HomeKey unit:=wdLine
.MoveDown
End With
Loop
End Sub
--
Greetings from Bavaria, Germany
Helmut Weber, MVP WordVBA
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000 (german versions)
I was thinking of doing some kind of Find & Replace, but wondered if a
more straightforward solution would be to locate and delete each tab
code found in the active paragraph.
How about this one:
Sub Test0002()
Dim rTmp As Range
Dim lCnt As Long
Set rTmp = Selection.Paragraphs(1).Range
With rTmp.Find
.Text = Chr(9)
If .Execute Then
rTmp.Collapse direction:=wdCollapseEnd
rTmp.End = Selection.Paragraphs(1).Range.End
Else
Exit Sub
End If
.Text = Chr(9)
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
With rTmp.Paragraphs(1).Range.ParagraphFormat
.LeftIndent = CentimetersToPoints(0.63)
.FirstLineIndent = CentimetersToPoints(-0.63)
.TabStops.ClearAll
.TabStops.Add _
Position:=CentimetersToPoints(0.63), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
End With
Steve
Why this line?
rTmp.End = Selection.Paragraphs(1).Range.End
>Why this line?
> rTmp.End = Selection.Paragraphs(1).Range.End
hmm...
I had an additional line in the code before, for testing.
rtmp.select.
The range rTmp, after a tab is found,
will be reduced to the tab,
the first tab in the paragraph, if there is any tab at all.
So I thought I'd have to expand it again
til the end of the paragraph.
No?
All comments and improvements are welcome.
By the way,
Dim lCnt As Long
was left over from testing as well.
Cheers
Helmut
The scope of a defined range is altered in an interesting manner using
Find and Replace. Take this one sentence paragraph,
Find Helmut if Helmut can be found.
Run this code.
Sub ScratchMacro()
Dim oRng As Word.Range
Set oRng = Selection.Paragraphs(1).Range
With oRng.Find
.Text = "Helmut"
If .Execute Then
oRng.Select 'Point A
oRng.Collapse wdCollapseEnd
With oRng.Find 'Point B
.Text = "Helmut"
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll 'Point C
End With
End If
End With
End Sub
While at Point A oRng is clearly limited to the text "Helmut." It must
be self expanding to the end of the initial range by Point B or it
couldn't find the sencond "Helmut" at Point C.
I see, I'll test and double test it,
but not before after tomorrow,
to make sure that you are right,
not to make sure that you are wrong.
Cheers
Helmut
>Sub ScratchMacro()
>Dim oRng As Word.Range
>Set oRng = Selection.Paragraphs(1).Range
>With oRng.Find
> .Text = "Helmut"
> If .Execute Then
> oRng.Select 'Point A
> oRng.Collapse wdCollapseEnd
> With oRng.Find 'Point B
> .Text = "Helmut"
> .Replacement.Font.Bold = True
> .Execute Replace:=wdReplaceAll 'Point C
> End With
> End If
>End With
>End Sub
Yessssss!
Cheers.
Helmut Weber