Avko
Administrator
Registrovan od:28.05.2014
Lokacija:zagreb
Predmet:
Re: Kod za korekciju teksta
Preuzmi
Izvorni kôd (Visual Basic):
Sub
main()
Dim
wdoc
As
Document
Dim
para
As
Paragraph
'ugasi ekran
Application.ScreenUpdating =
False
'brisanje praznih redova, broja titla i vrijeme umetanja titla
For
Each
para
In
ActiveDocument.Paragraphs
If
Not
para.Range.Information(wdWithInTable)
Then
If
Len(para.Range.Text) = 1
Then
para.Range.Delete
para.Range.Delete
para.Range.Delete
End
If
End
If
Next
'brisanje novog reda
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With
Selection.Find
.Text =
"^p"
.Replacement.Text =
" "
//NAPOMENA: OVDJE JE RAZMAK IZMEDU NAVODNIKA
.Forward =
True
.Wrap = wdFindAsk
.Format =
False
.MatchCase =
False
.MatchWholeWord =
False
.MatchWildcards =
False
.MatchSoundsLike =
False
.MatchAllWordForms =
False
End
With
Selection.Find.Execute Replace:=wdReplaceAll
'brisanje razmaka
'ako je nesto krivo uhvati gresku
On
Error
GoTo
ERRORHANDLER
'provjera razmaka izmedu rijeci
With
Selection
.HomeKey Unit:=wdStory
With
.Find
.ClearFormatting
.Replacement.ClearFormatting
'ovdje gleda razmak izmedu redova
.Text =
" [ ]@([! ])"
'stavi samo jedan razmak
.Replacement.Text =
" \1"
.MatchWildcards =
True
.Wrap = wdFindStop
.Format =
False
.Forward =
True
'izvrsi zamjenu vise razmaka u jedan
.Execute Replace:=wdReplaceAll
End
With
With
.Find
'gleda razmak nakon paragrafa
.Text =
"^p "
'samo paragraf bez razmaka
.Replacement.Text =
"^p"
.MatchWildcards =
False
.Wrap = wdFindStop
.Format =
False
.Forward =
True
'zamjeni
.Execute Replace:=wdReplaceAll
End
With
End
With
ERRORHANDLER
:
With
Selection
.ExtendMode =
False
.HomeKey Unit:=wdStory
End
With
'aktiviraj ekran
Application.ScreenUpdating =
True
End
Sub
zivot je moja domovina.
Ovaj post je ureden
1
puta. Posljednja izmjena 13.06.2017 12:32 od strane Avko.