White Man |
11.06.2017 21: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 22:21 |
Predmet:Re: Kod za korekciju teksta
PreuzmiIzvorni kôd (Visual Basic):Sub SamoTekst()
'
Dim Dok As Document
Dim Temp As String, ArRijeci() As String
Dim I As Integer, N As Integer
Dim Str As String
Dim Reper As Boolean, Poz As Integer
Reper = False
Set Dok = ActiveDocument
Temp = Dok.ActiveWindow.Selection
ArRijeci = Split(Temp, vbCr)
For I = LBound(ArRijeci) To UBound(ArRijeci) - 1
If Reper = True Then
Poz = InStr(1, ArRijeci(I), ">")
If Poz > 0 Then
ArRijeci(I) = Mid(ArRijeci(I), Poz + 1)
Poz = InStr(1, ArRijeci(I), "<")
If Poz > 0 Then
ArRijeci(I) = Left(ArRijeci(I), Poz - 1)
End If
End If
If ArRijeci(I) = "" Then
Reper = False
End If
Str = Str & ArRijeci(I) & " "
End If
If InStr(1, ArRijeci(I), "-->") > 0 Then
Reper = True
End If
Next I
Selection.TypeText (Str)
End Sub
|
White Man |
11.06.2017 22: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 23: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 |
12.06.2017 00: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 11: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 13: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 16:19 |
Predmet:Re: Kod za korekciju teksta
PreuzmiIzvorni 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
|