|
Dobry den, U konecneho Worddokumentu ketry se vytvari skladanim nekolika ruznych Worddokumentu je spatne cislovani odstavcu. Snazim se: #1 smazat vsechna cislovani #2 na jejich mista umistit bookmarky #3 vytvoreni noveho cislovani pri uchovani graficke struktury dokumentu Momentalne mi nefunguje viceurovnove cislovani a i vysleny dokument je "rozhozeny". Vyzna se nekdo v teto oblasti? Dekuji. (bez diakritiky, cestina neni naistalovana na PC)
Public Sub cislovaniOdstavcu()
' macro to correct errors after paste
' to another document and style changes
Dim aPara As Paragraph
Dim aBookmark As Bookmark
Dim StyleName As String
Dim RestartPoint As Range
Dim ListItem As Paragraph
Dim n As Integer ' bookmark id
n = 1
' reset the paragraph formatting of the style if the paragraph
' should be numbered in this document
For Each aPara In ActiveDocument.Paragraphs
StyleName = aPara.Style
'If ActiveDocument.Styles(StyleName).ListGalleries(wdNumberGallery) > 0 Then
If ActiveDocument.Styles(StyleName).ListLevelNumber > 0 Then
aPara.Reset
End If
Next aPara
For Each ListItem In ActiveDocument.ListParagraphs
MsgBox ("listitem" & ListItem.Range.Text)
If 0 = 0 Then 'ListItem.Style = ActiveDocument.Styles(wdStyleListNumber).NameLocal Then
MsgBox (ListItem.Style)
If ListItem.Range.ListFormat.ListValue = 1 Then
ActiveDocument.Bookmarks.Add "restart" & n, ListItem.Range
MsgBox (n)
n = n + 1
End If
End If
Next ListItem
' reapply restarts to bookmarked paragraphs and tidy up
For Each aBookmark In ActiveDocument.Bookmarks
If aBookmark.Name Like "restart*" Then ' it's a restart
Set RestartPoint = aBookmark.Range
RestartPoint.Collapse wdCollapseEnd
RestartPoint.MoveEnd unit:=wdCharacter, Count:=-1
Selection.InsertAfter ("a")
RestartPoint.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
wdNumberGallery).ListTemplates(7), ContinuePreviousList:=False, ApplyTo:= _
wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
'aBookmark.Delete
End If
Next aBookmark
End Sub
|