How to skip tables in a macro designed to typemark paragraphs

[AnnaL]

I am trying to get a macro to typemark the beginning of each paragraph, but it keeps getting stuck because there are tables, which it wants to typemark but shouldn't. I read this thread: vbaexpress.com/forum/showthread.php?37455-Solved-Check-whether-a-loop-has-encountered-a-table-and-then-skip-it. I wasn't sure how to apply it to mine, so if anyone could help that would be appreciated. I am including my macro below and I have bolded where an error occurs.



Selection.HomeKey Unit:=wdStory ' Start at the beginning of the word doc
' Double space the document
ActiveDocument.Paragraphs.LineSpacingRule = wdLineSpaceDouble
' Change font to 12 pt times new roman
ActiveDocument.content.Font.Size = 12
ActiveDocument.content.Font.Name = "Times New Roman"

Dim curTypemark As String ' Variable for a typemark
curTypemark = "" ' Initial instantiation is the empty string

' This sub's code largely copies that of CheckTypemarks, so more verbose
' comments are in that sub
Dim oPrg As Paragraph ' placeholder for a paragraph

' Loop through each paragraph
For Each oPrg In ActiveDocument.Paragraphs
Dim paraRng As Range
Set paraRng = oPrg.Range

If (oPrg.Style = "tx" Or oPrg.Style = "sb1tx") Then
paraRng.MoveEnd Unit:=wdCharacter, Count:=-1
paraRng.InsertAfter (vbCr)
End If

If (Not (curTypemark = oPrg.Style)) Then
curTypemark = oPrg.Style
paraRng.InsertBefore ("<" + curTypemark + ">")

If (Not (oPrg.Style = "cn" Or oPrg.Style = "tx" Or oPrg.Style = "ins-art" Or oPrg.Style = "ins-photo" Or oPrg.Style = "a" Or oPrg.Style = "b" Or oPrg.Style = "c" Or oPrg.Style = "d")) Then
paraRng.MoveEnd Unit:=wdCharacter, Count:=-1
paraRng.InsertAfter (vbCr)
End If

If (oPrg.Style = "a" Or oPrg.Style = "b" Or oPrg.Style = "c" Or oPrg.Style = "d") Then
paraRng.MoveEnd Unit:=wdCharacter, Count:=-1
paraRng.InsertBefore (vbCr)
End If

End If
Next

End Sub

[gmaxey]

Try:


Sub Test()
Dim curTypemark As String
Dim oPar As Paragraph ' placeholder for a paragraph
Dim oRng As Range
curTypemark = vbNullString
With ActiveDocument
.Paragraphs.LineSpacingRule = wdLineSpaceDouble
.Content.Font.Size = 12
.Content.Font.Name = "Times New Roman"
For Each oPar In .Paragraphs
Set oRng = oPar.Range
oRng.Select
If Not oRng.Information(wdWithInTable) Then
If (oPar.Style = "tx" Or oPar.Style = "sb1tx") Then
oRng.MoveEnd Unit:=wdCharacter, Count:=-1
oRng.InsertAfter (vbCr)
End If
If (Not (curTypemark = oPar.Style)) Then
curTypemark = oPar.Style
oRng.InsertBefore ("<" + curTypemark + ">")
If (Not (oPar.Style = "cn" Or oPar.Style = "tx" Or oPar.Style = "ins-art" Or oPar.Style = "ins-photo" Or oPar.Style = "a" Or oPar.Style = "b" Or oPar.Style = "c" Or oPar.Style = "d")) Then
oRng.MoveEnd Unit:=wdCharacter, Count:=-1
oRng.InsertAfter (vbCr)
End If
If (oPar.Style = "a" Or oPar.Style = "b" Or oPar.Style = "c" Or oPar.Style = "d") Then
oRng.MoveEnd Unit:=wdCharacter, Count:=-1
oRng.InsertBefore (vbCr)
End If
End If
End If
Next
End With
End Sub

[AnnaL]

Thank you so much. I think that will work.

Do I need to insert this string anywhere or it doesn't matter?: Selection.HomeKey Unit:=wdStory ' Start at the beginning of the word doc