Bosna i Hercegovina



#1 06.10.2014-23:07
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: Kod za korekciju teksta
Moze li neko da mi napise kod, koji ce kad ubacim title u word, da obrise one brojeve od frejmova i ostane samo suvi tekst? Primer A je kako izgleda kad se iskopira titl, a primer B je kako bi trebalo da izgleda kada se aktivira kod. Hvala puno unapred.

Prilozi:
Informacije o fajlu: doc  A.doc
Preuzimanja: 52
Veličina: 22.5 KB
Informacije o fajlu: doc  B.doc
Preuzimanja: 42
Veličina: 22 KB

↑  ↓

#2 07.10.2014-12:26
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,490


Subject: Re: Kod za korekciju teksta
Evo ti kod.
Postaviti vjerujem da znas.
DownloadIzvorni kod (Visual Basic):
  1. Sub SamoTekst()
  2. '
  3. Dim Dok As Document
  4. Dim Temp As String, ArRijeci() As String
  5. Dim I As Integer
  6. Dim Str As String
  7. Dim Reper As Boolean
  8.  
  9.  
  10. Reper = False
  11. Set Dok = ActiveDocument
  12. Temp = Dok.ActiveWindow.Selection
  13. ArRijeci = Split(Temp, vbCr)
  14. For I = LBound(ArRijeci) To UBound(ArRijeci) - 1
  15.     If Reper = True Then
  16.     Str = Str & ArRijeci(I) & " "
  17.     Reper = False
  18.     End If
  19.     If InStr(1, ArRijeci(I), "-->") > 0 Then
  20.     Reper = True
  21.     End If
  22. Next I
  23. Selection.TypeText (Str)
  24. End Sub

Pozdrav
↑  ↓

#3 07.10.2014-20:32
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: Re: Kod za korekciju teksta
To je to, hvala. Samo mi recite jos, gde u kodu modu da dodam da mi izbaci neke znakove koji se pojavljuju u tekstu? Jer negde u tekstu ispred recenice stoji <i> a na kraju </i>. Pa kako i gde u kodu, dodajem ove znakove da ih izbaci? Hvala unapred.
↑  ↓

#4 08.10.2014-19:47
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,490


Subject: Re: Kod za korekciju teksta
Evo novi kod.
DownloadIzvorni kod (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.     Str = Str & ArRijeci(I) & " "
  24.     Reper = False
  25.     End If
  26.     If InStr(1, ArRijeci(I), "-->") > 0 Then
  27.     Reper = True
  28.     End If
  29. Next I
  30. Selection.TypeText (Str)
  31. End Sub

Pozdrav
↑  ↓

#5 08.10.2014-20:47
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: Re: Kod za korekciju teksta
Radi, hvala.
↑  ↓

#6 11.06.2017-17:58
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: Re: Kod za korekciju teksta
Da li moze da se doradi ovaj kod? Jer kad ima dva ili vise reda u frejmu on samo prvi odvoji. Hvala puno unapred.
↑  ↓

#7 11.06.2017-20:23
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,490


Subject: Re: Kod za korekciju teksta
zakaci primjer.
Pozdrav
↑  ↓

#8 11.06.2017-20:36
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: Re: Kod za korekciju teksta
Na primer iz ovog titla, da izvuce sav tekst. Hvala unapred.

Prilozi:
Informacije o fajlu: rar  Bitcoin.The.End.of.Money.as.We.Know.It.English.txt.rar
Preuzimanja: 34
Veličina: 32.13 KB

↑  ↓

#9 11.06.2017-21:21
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,490


Subject: Re: Kod za korekciju teksta
DownloadIzvorni kod (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

Pozdrav
↑  ↓

#10 11.06.2017-21:50
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: Re: Kod za korekciju teksta
Nece opet nesto kako treba. Odvoji samo nesto manje od pola teksta. Da ne postoji neki limit?
↑  ↓

#11 11.06.2017-22:28
Gjoreski Offline
Super Moderator
Registrovan/a od: 02.02.2009-22:24
Komentari: 1,339


Subject: 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
↑  ↓

#12 11.06.2017-23:38
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: 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:
Informacije o fajlu: rar  Drugi kod.rar
Preuzimanja: 46
Veličina: 16.14 KB
Informacije o fajlu: rar  Prvi kod.rar
Preuzimanja: 85
Veličina: 21.42 KB

↑  ↓

#13 12.06.2017-10:46
zxz Offline
Administrator
Registrovan/a od: 03.02.2009-16:22
Komentari: 9,490


Subject: 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.
Pozdrav
↑  ↓

#14 12.06.2017-12:50
White Man Offline
Clan
Registrovan/a od: 11.03.2011-16:39
Komentari: 286


Subject: 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.
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 13.06.2017-11:35 od strane Avko. ↑  ↓

#15 12.06.2017-15:19
Avko Offline
Administrator
Registrovan/a od: 28.05.2014-09:21
Komentari: 2,766


Ocjena: Ocjena:100 Subject: Re: Kod za korekciju teksta
DownloadIzvorni kod (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

Newton laže! Lake padaju brže!
Ovaj komentar je mijenjan 1 puta. zadnja izmjena 13.06.2017-11:32 od strane Avko. ↑  ↓

Stranice (2): 1, 2


All times are GMT +01:00. Current time: 24.11.2017-14:02.