Jednoliterówki i zaimki na końcu wierszy –rozwiazanie[MAKRO]

Przykładowe rozwiązanie problemu.
POniźsze makro w wordzie wykona czynności
1 znadzie podwójne sapcje i zamieni na pojedyńczą (waźne dla działania punktu 2–go)
2. znajdzie i przeniesie do nowej linii [poprzez dodanie twardej spacji za wyrazem] tekst zdefiniowany w kolekcji (spójniki i zaimki – chyba tak sięto nazywa, polonistą nie jestem)

UPDATE 1 16 –03 2006 (mała zmiana – konieczna)

UPDATE 2 17 –03–2006

poniźej poprawiony kod
Sub przenies_spojniki_i_wyrazy()
' Makro zapisane 2006–03–17 przez Dividos (Dawid Ławnicki)
' dvd1(at)epf.pl
' ver. 0.92
'

'#$* <>
' USUWANIE PODWOJNYCH SPACJI
'jeśli program ma nie usówać podwójnych spacji ustaw zmienną na zero
'ale moźe to spowodować niewłaściwe działanie
'jeśli na końcu lini będzie więcej niź jedna spacja !!!
usun_spacje = 1

' poniźej wpisz ile spacji się podziewasz obo siebie
ile_spacji = 10

' # konfiguracja – tu wpisz jakie słowa mają być przenoszone z końca lini
Dim a As Byte
Dim dane As New Collection

' UWAGA !!! wszystkie spójniki i słowa pisz małą literą – KONIECZNIE
' makro zrobi resztę ;)
dane.Add "a"
dane.Add "i"
dane.Add "o"
dane.Add "u"
dane.Add "w"
dane.Add "z"
dane.Add "ze"
dane.Add "od"
dane.Add "do"
dane.Add "źe"
dane.Add "poprzez"
dane.Add "spod"
dane.Add "sponad"
dane.Add "znad"
dane.Add "oraz"
dane.Add "ale"
dane.Add "lub"
dane.Add "albo"
dane.Add "bądź"
dane.Add "czy"
dane.Add "po"
dane.Add "za"
dane.Add "nad"
dane.Add "na"
dane.Add "oraz"

'dopisz ew co potrzeba

'#$* >>=============== KONFIGURACJA koniec ================<<


If usun_spacje = 1 Then
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
' Call usun_spacje_podwojne(1)
Call usun_spacje_podwojne(ile_spacji)
End If ' usun spacje podwojne

'# IDZ NA POCZĄTEK TEKSTU – CTRL_HOME
Selection.HomeKey Unit:=wdStory, Extend:=wdMove

' zmienna Petla – lie razy ma być całość wykonana
' doświadczalenie wyszlo źe min 2 razy
Petla = 2
While Petla >= 1
' wyszukanie frazy zawartej w kolekcji dane
For a = 1 To dane.Count
Szukaj = 1
With Selection.Find
.Text = Chr(32) & dane(a) & Chr(32)
'.Replacement.Text = "" '
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
While Szukaj = 1
'licznik_while = licznik_while + 1 'testowe było
If Selection.Find.Execute = True Then
'badanie czy na końcu linii
linia$ = ActiveDocument.Bookmarks("\line").Range.Text
If Len(linia$) > 3 Then
'kopiowanie ostatniego słowa (wraz ze spacją na końcu jeśli jest)
' i przypsanie go do zmiennej slowo
Selection.EndKey Unit:=wdLine
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
slowo = ActiveDocument.Bookmarks("\Sel").Range.Text
male_slowo = LCase(slowo)
Selection.EndKey Unit:=wdLine
test = dane(a)
'MsgBox (test)
' sprawdza czy bierzacy element jest taki sam jak zmienna slowo
If male_slowo = dane(a) & Chr(32) Or male_slowo = dane(a) Then
Selection.MoveLeft Unit:=wdWord, Count:=1
.Text = dane(a) & Chr(32)
.Replacement.Text = dane(a) & Chr$(160)
.Execute Replace:=wdReplaceOne
.Text = Chr(32) & slowo & Chr(32)
Selection.MoveUp Unit:=wdLine, Count:=1
For b = 1 To dane.Count
'ponowne kopiowanie ostatniego słowa (wraz ze spacją na końcu jeśli jest)
' i przypsanie go do zmiennej slowo2$ by poprawiał kilka słów obok np "i z"
Selection.EndKey Unit:=wdLine
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
slowo2$ = ActiveDocument.Bookmarks("\Sel").Range.Text
male_slowo2 = LCase(slowo2$)
Selection.EndKey Unit:=wdLine
If male_slowo2 = dane(b) & Chr(32) Or male_slowo2 = dane(b) Then
Selection.MoveLeft Unit:=wdWord, Count:=1
.Text = dane(b) & Chr(32)
.Replacement.Text = dane(b) & Chr$(160)
.Execute Replace:=wdReplaceOne
.Text = Chr(32) & dane(b) & Chr(32)
' wraca do tego samego wiersza (czyli o jeden wyźej)
Selection.MoveUp Unit:=wdLine, Count:=1
' RESETOWANIE ZMIENNE BY PRZESZUKAŁ CAŁA TABLICE RAZ JESZCZE
' inaczej bedą błędy – zostawi część złó lub spójników
b = 1
End If
Next b
.Text = Chr(32) & dane(a) & Chr(32)
End If ' porownanie slowa z bierzacy
End If ' Len linia$ > 3
Else: Szukaj = Szukaj – 1 'jeśli selection.find = false (jesli nie znajdzie–chyba)
End If ' selection true
Wend 'szukaj = 1

'==========================
End With 'selection find
Next a
Petla = Petla – 1
'MsgBox (licznik_while)' testowo okienko
Wend
End Sub
Sub usun_spacje_podwojne(licznik)
'
' Makro1 Makro
' Makro zapisane 2006–03–13 przez Admin
'USUŃ PODÓJNE SPACJE Z CAŁEGO DOKUMENTU – POWTÓRZ CZYNNOŚĆ 5 RAZY

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
For n = 1 To licznik
Selection.Find.Execute Replace:=wdReplaceAll

Next n
End Sub


Czekam na wszelkie uwagi i ulepszenia :)

Odpowiedzi: 8

Próbuje i mi się niestety wykrzacza. Nie wiem dlaczego, ale wywala błąd: [code]Runtime error: 5941 Zadany element kolekcji nie istnieje[/code] nie wiem co mam zrobic, praca napisana a ręcznie to robic to będzie dramat. Proszę o pomoc
pulkownik
Dodano
24.04.2007 15:54:27
Dividos:
"... Klikasz uruchom i...
.....odsuuń się bo ekran wybuchnie ;) joke
Prościej chyba się nie da..."


he he he, to działa, i faktycznie nie wybucha :wink:
chociaź nie wyśliwtliło mi się na początku okno z tym

Sub makro
.
.
.
End Sub

ale w końcu udało się.
dzięki piękne.


przy okazji.
jeźeli na końcu wiersza będą dwie cyfry, np

".......zlecenie z dnia 12
marca 2006 r....."

da się coś dopisać w jednym wierszu do kodu źeby liczbę teź przeniósł?
czy trzeba wpisać wszystkie 31?
tomeck
Dodano
27.04.2006 19:13:50
1
W wordzi ekolejno menu:
narzędzia / makro / zarejestruj nowe makro –> klikasz ok

potem pojawia sięmałe okienko na którym klikasz stop (znaczy się kwadracik oznaczający stop jak w odtwarzaczu CD)

2
Natępnie
narzędzia / makro / Edytor visual basic

Powinno ci się pokazać coś w stylu


Sub Makro1()
'
' Makro3 Makro
' Makro zapisane 2006–04–26 przez ...........
'
End Sub


Usuwasz to i zamiast tego wklejasz kod makra podany na tej stronie
zapisujesz zmiany,

3
i dalej
narzędzia / makro / Makra

i powinieneśmieć do wyboru makro o nazwie:
przenies_spojniki_i_wyrazy

Klikasz uruchom i...
.....odsuuń się bo ekran wybuchnie ;) joke

Prościej chyba się nie da
Dividos
Dodano
26.04.2006 15:26:27
wytłumaczcie mi jak dla blondynki jak mam to makro uruchomić?
tomeck
Dodano
26.04.2006 11:00:56
Poniekąd to prawda – po napisaniu i sformatowaniu tekstu – czyli po ostatecznej obróbce (wielkość grubość czcionki). Dlatego źe jak amienisz wielkość czionki lub jej grubość bądź krój to moźe się okazać źe juź część spójników nie jest na końcu linijki i nie trzeba wstawiać za nim twardej spacji by przeszedł do nowej linii. Jednak to makro nie działa jak inne n forum. Tamto wstawiało znak nowej linii przed spójnikiem – i to powodowło źe po zmianie np wielkośći czcionki trzeba było usówać znaki końca liniii by tekst normalnie wyglądał.
Zrób sobi ekopię tekstu i "pobaw się" a zobaczysz jak to działa. Moźe wychwycisz jakieśbłędy. Powodzenia!
Dividos
Dodano
20.03.2006 08:15:11
Tak, teraz jest wszystko jasne. Pozostaje mi tylko zastosować to w praktyce bo jeszcze tego nie zrobiłem. Gdzieś przeczytałem, źe makro trzeba uruchomić dopiero po zakończeniu pisania tekstu. Czy to prawda?
krzys231
Dodano
19.03.2006 23:52:31
Moźe źle mnie zrozumiałeś. Zauwaź źe ten opis znajduje się w kodzie i w części konfiguracujnej. Chodzi więc o to by wymieniane tam (w makrze) spójniki były małą literą, a nie w tekście.
Dividos
Dodano
19.03.2006 23:21:04
Davidos Napisał:

' UWAGA !!! wszystkie spójniki i słowa pisz małą literą – KONIECZNIE
' makro zrobi resztę ;)

A jeśli będę zaczynał zdanie np. W Krakowie dziś padał deszcz. Muszę pamiętać, źeby było małe w? :shock:
krzys231
Dodano
18.03.2006 23:33:12
Dividos
Dodano:
16.03.2006 00:40:26
Komentarzy:
8
Strona 1 / 1