Prikazi cijelu temu 12.06.2017 15:19
Avko Van mreze
Administrator
Registrovan od:28.05.2014
Lokacija:zagreb


Predmet:Re: Kod za korekciju teksta
PreuzmiIzvorni kôd (Visual Basic):
  1. Sub main()
  2.     Dim wdoc As Document
  3.     Dim para As Paragraph
  4.    
  5.     'ugasi ekran
  6.    Application.ScreenUpdating = False
  7.     'brisanje praznih redova, broja titla i vrijeme umetanja titla
  8.    For Each para In ActiveDocument.Paragraphs
  9.         If Not para.Range.Information(wdWithInTable) Then
  10.             If Len(para.Range.Text) = 1 Then
  11.                 para.Range.Delete
  12.                 para.Range.Delete
  13.                 para.Range.Delete
  14.             End If
  15.         End If
  16.     Next
  17.    
  18.     'brisanje novog reda
  19.    Selection.WholeStory
  20.     Selection.Find.ClearFormatting
  21.     Selection.Find.Replacement.ClearFormatting
  22.     With Selection.Find
  23.         .Text = "^p"
  24.         .Replacement.Text = " " //NAPOMENA: OVDJE JE RAZMAK IZMEDU NAVODNIKA
  25.         .Forward = True
  26.         .Wrap = wdFindAsk
  27.         .Format = False
  28.         .MatchCase = False
  29.         .MatchWholeWord = False
  30.         .MatchWildcards = False
  31.         .MatchSoundsLike = False
  32.         .MatchAllWordForms = False
  33.     End With
  34.     Selection.Find.Execute Replace:=wdReplaceAll
  35.    
  36.     'brisanje razmaka
  37.    'ako je nesto krivo uhvati gresku
  38.    On Error GoTo ERRORHANDLER
  39.     'provjera razmaka izmedu rijeci
  40.    With Selection
  41.         .HomeKey Unit:=wdStory
  42.         With .Find
  43.             .ClearFormatting
  44.             .Replacement.ClearFormatting
  45.              'ovdje gleda razmak izmedu redova
  46.            .Text = " [ ]@([! ])"
  47.              'stavi samo jedan razmak
  48.            .Replacement.Text = " \1"
  49.             .MatchWildcards = True
  50.             .Wrap = wdFindStop
  51.             .Format = False
  52.             .Forward = True
  53.              'izvrsi zamjenu vise razmaka u jedan
  54.            .Execute Replace:=wdReplaceAll
  55.         End With
  56.          
  57.         With .Find
  58.              'gleda razmak nakon paragrafa
  59.            .Text = "^p "
  60.              'samo paragraf bez razmaka
  61.            .Replacement.Text = "^p"
  62.             .MatchWildcards = False
  63.             .Wrap = wdFindStop
  64.             .Format = False
  65.             .Forward = True
  66.              'zamjeni
  67.            .Execute Replace:=wdReplaceAll
  68.         End With
  69.     End With
  70. ERRORHANDLER:
  71.     With Selection
  72.         .ExtendMode = False
  73.         .HomeKey Unit:=wdStory
  74.     End With
  75.     'aktiviraj ekran
  76.    Application.ScreenUpdating = True
  77. End Sub

zivot je moja domovina.
Ovaj post je ureden 1 puta. Posljednja izmjena 13.06.2017 11:32 od strane Avko.