White Man 11.06.2017 20:36
Predmet:Re: Kod za korekciju teksta

Na primer iz ovog titla, da izvuce sav tekst. Hvala unapred.
Prilozi:
Bitcoin.The.End.of.Money.as.We.Know.It.English.txt.rar (Velicina datoteke:32.13 KB)

zxz 11.06.2017 21:21
Predmet:Re: Kod za korekciju teksta

PreuzmiIzvorni kôd (Visual Basic):
  1. Sub SamoTekst()
  2. '
  3. Dim Dok As Document
  4. Dim Temp As String, ArRijeci() As String
  5. Dim I As Integer, N As Integer
  6. Dim Str As String
  7. Dim Reper As Boolean, Poz As Integer
  8.  
  9. Reper = False
  10. Set Dok = ActiveDocument
  11. Temp = Dok.ActiveWindow.Selection
  12. ArRijeci = Split(Temp, vbCr)
  13. For I = LBound(ArRijeci) To UBound(ArRijeci) - 1
  14.     If Reper = True Then
  15.     Poz = InStr(1, ArRijeci(I), ">")
  16.         If Poz > 0 Then
  17.         ArRijeci(I) = Mid(ArRijeci(I), Poz + 1)
  18.         Poz = InStr(1, ArRijeci(I), "<")
  19.             If Poz > 0 Then
  20.             ArRijeci(I) = Left(ArRijeci(I), Poz - 1)
  21.             End If
  22.         End If
  23.         If ArRijeci(I) = "" Then
  24.            Reper = False
  25.         End If
  26.     Str = Str & ArRijeci(I) & " "
  27.     End If
  28.     If InStr(1, ArRijeci(I), "-->") > 0 Then
  29.     Reper = True
  30.     End If
  31. Next I
  32. Selection.TypeText (Str)
  33. End Sub

White Man 11.06.2017 21:50
Predmet:Re: Kod za korekciju teksta

Nece opet nesto kako treba. Odvoji samo nesto manje od pola teksta. Da ne postoji neki limit?

Gjoreski 11.06.2017 22:28
Predmet:Re: Kod za korekciju teksta

Koliko ja vidim ovaj teks ima tocno odredena struktura , taka da ako nema nekoja druga struktura ova e lesno da se izvadi samo tekstot.
Logika bi bila da izvuces posle broja i vreme linije koi nisu prazne

White Man 11.06.2017 23:38
Predmet:Re: Kod za korekciju teksta

Nije dobar kod, evo stavicu primere da se vidi, sa prvim kodom nije izvukao sav tekst i ima 7 stranica a sa drugim je lepo poceo da izvlaci ali nema vise od pola, samo 4 stranice. Ako moze da se doradi kod? Hvala unapred.
Prilozi:
Drugi kod.rar (Velicina datoteke:16.14 KB)
Prvi kod.rar (Velicina datoteke:21.42 KB)

zxz 12.06.2017 10:46
Predmet:Re: Kod za korekciju teksta

Nije ti to do koda nego do racunara jer veliko je to pa nema dovoljno memorije da odradi.
podijeli na vise datoteka.
kao sto kaze Gjoreski ovaj fajl ima strukturu pa bi se to moglo uraditi direktno iz fajla a ne iz vorda.

White Man 12.06.2017 12:50
Predmet:Re: Kod za korekciju teksta

Kod os zxz-a postavi tekst kao u knjizi samo sto ne moze sve da obuhvati. Kako ste mislili da moze direktno iz fajla da se uradi? Hvala puno unapred.

Avko 12.06.2017 15:19
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