Nie wiem jak wam, ale mi to makro niezbyt dobrze działa. Word zawiesza się podczas działania tego makra.

ciąg dalszy w nowym wątku
http://forum.centrumxp.pl/viewtopic.php?p=298193#298193

mile widziane testy i wskazówki

Pomysł ciekawy i pewnie jak będę to przerabiał od podstaw to wykorzystam kolekcje, ale jednak ze sprawdzanie tylko na końcu linii – nie wszędzie

Waźne pytanie: Jak wprawdzić źę dana litera to spis treści (pole spisu treści tworzone automatycznie) bo makro się zapetla w tym miejscu.????

POza tym nie sprawdza się w tabelach oraz w tekście w którym uźyto automatycznego dzielenia wyrazów.
Ale stopniowo i to da sięzrobić. Tyle tylko ze to makro to moje pierwsze makro w vb :( Liczę więc na Waszą pomoc :roll:

Witam
Worda uźywam tylko do prostych tekstów i nie mam wielkiego doświadczenia. Jeśli nie będzie stanowić problemu, źe twarde spacje bądą wstawiane wszędzie a nie tylko na końcu wiersza to proponuję poniźszy kod.

Dim a As Byte
Dim dane As New Collection
dane.Add "A"
dane.Add "a"
dane.Add "I"
dane.Add "i"
dane.Add "O"
dane.Add "o"
dane.Add "U"
dane.Add "u"
dane.Add "W"
dane.Add "w"
dane.Add "Z"
dane.Add "z"
dane.Add "Po"
dane.Add "po"
dane.Add "Za"
dane.Add "za"
dane.Add "Nad"
dane.Add "nad"
dane.Add "Na"
dane.Add "na"
dane.Add "Oraz"
dane.Add "oraz"
'dopisz co tam chcesz

For a = 1 To dane.Count
With Selection.Find
.Text = dane(a)
.Replacement.Text = dane(a) & Chr$(160)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
With Selection.Find
.Text = dane(a) & Chr$(160) & Chr(32)
.Replacement.Text = dane(a) & Chr$(160)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
Next a
End Sub

Pozdrawiam

ohcyR:

Witaj.
Chr$(160).
Pozdrawiam

No tego nie mogłem znaleźć Dzięki za podpowiedź!!

Co do twardych spacji to moje załoźenie jest takie iź bedę tego uzywał do pracy dyplomowej lub innego rodzaju dokumentów. Dokłądnie chodzi o sytuację gdy w dokumencie były wstawiane twarde spacje i następnie była dokonana zmiana wielkości czcionki i powstał efekt o jakim pisał "kierofca". Ale ok jek tylko znajdę chwilęto dodam na samym początku zmienne (flagi) decydujace o tym co ma być robione, np usun_tw_spacje = 0

Jest jeszcze inny błąd – makro zapętl asięjak trafi na automatycznie tworzony spis tabel, wykresów czy spis treści.

Wie ktoś moźe jak dodać wykrywanie takich pól?

Witaj.
Makro działa dobrze. (5+) :)

W kodzie miałem problem ze wstawieniem twardej spacji przy pomocy Ctrl+Shift+Enter więc zamieniłem ją na Chr$(160).

Nie do końca rozumiem potrzebę wstępnego kasowania twardych spacji, bo uźywam ich do pisania dat typu 12 marca 2006 itp. i skasowanie ich, w tym przypadku, jest błędem.

Pozdrawiam

Znalezienie rozwiązania sporo zajęło. Okazuje się źe forum wycina znaki bckslash przed slowem line i innymi jesli nie jest to w znacznikach kodu. Tu powinno być dobrze

Niemniej postanowlem udoskonalic to makro.
opis jest w komentarzach kodu

Sub przenies_spojniki_full()

' Makro napisane (zmodyfikowane) 2006–03–11 przez Dividos'a
' a wziete z forum centrumxp :)

'USUWA PODÓJNE SPACJE Z CAŁEGO DOKUMENTU – POWTARZA CZYNNOŚĆ 5 RAZY
' znajdzie twarde spacje i zamieni na zwykłe – tak w razie czego gdyby zmieniana była wielkosc czcionki
' PRZENIESIE LITERY "a i o u w z" oraz A I O U W Z
' DO NOWEGO WIERSZA – NIE POPRZEZ SHIFT ENTER a poprzez dodanie twardej spacji za spojnikiem

' DO ZROBIENIA ... kiedyś:

' nie potrafi poprawic np dwoch i: " i i i " – przenosi tylko jedno :(
' a jak jest na koncu " i z " to teź nie zrobi
' ZROBIONE – SPRAWDZA LINIĘ DOPÓKI NIE BĘDZIE TAK JAK MA BYĆ :)

' dodac wyszukiwanie krótkich słów np: "po, za, nad ..."

'====>> start makra: <
'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
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll

' znajdz twarde spacje i zamień na zwykłe – w razie czego jesli zmieniana była wielkosc czcionki
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
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll

' PONIŻEJ FUNKCJA KTÓRA PRZENIESIE LITERY a i o u w z ORAZ DUŻE LITERY TE SAME
' DO NOWEGO WIERSZA – NIE POPRZEZ SHIFT ENTER
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
Petla = 1

While Petla = 1
linia$ = ActiveDocument.Bookmarks("\line").Range.Text
If Len(linia$) > 3 Then
Selection.EndKey Unit:=wdLine, Extend:=wdMove
Spacje = 0
ZnakOK = 0
wstawienie = 0
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
a1$ = ActiveDocument.Bookmarks("\sel").Range.Text
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
a2$ = ActiveDocument.Bookmarks("\Sel").Range.Text
' ### test czy cale slowa zczyta
'Selection.EndKey Unit:=wdLine
' Selection.MoveLeft Unit:=wdCharacter, Count:=1
'Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
'slowo$ = ActiveDocument.Bookmarks("\Sel").Range.Text
' ## test koniec
' ##* NIE działa lepiej dać sobie spokój z tym
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdMove
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
a3$ = ActiveDocument.Bookmarks("\Sel").Range.Text
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdMove


a1_liczba = Asc(a1$)
a2_liczba = Asc(a2$)
a3_liczba = Asc(a3$)

If a1_liczba = 32 And a3_liczba = 32 Then
Spacje = 1
End If

' If slowo$ = "nad" or a2_lizna = 97 ... takie coś trzeb aodać by dzialalo ze slowami
If a2_liczba = 97 Or a2_liczba = 105 Or a2_liczba = 111 Or a2_liczba = 117 Or a2_liczba = 119 Or a2_liczba = 122 Or a2_liczba = 65 Or a2_liczba = 73 Or a2_liczba = 79 Or a2_liczba = 85 Or a2_liczba = 87 Or a2_liczba = 90 Then
ZnakOK = 1
End If

If Spacje = 1 And ZnakOK = 1 Then
'stara (wywalona linia) wstawia shift enter "Selection.TypeText Text:=Chr$(11)", zamiast tego to co ponizej
' => ustwia sie na koncu linii
Selection.EndKey Unit:=wdLine
'skasuj spację na koncu linii
Selection.TypeBackspace
' wstaw twardą spację.tu \/ jest TWARDA SPACJA wstawiana w edytorze VB poprzez ctrl+shift+spacja
Selection.TypeText Text:=""
wstawienie = 1
Selection.MoveUp Unit:=wdLine, Count:=1
End If
End If

If wstawienie = 0 Then
Selection.MoveDown Unit:=wdLine, Count:=1
End If

Selection.EndKey Unit:=wdLine, Extend:=wdMove

If Selection.Type = wdSelectionIP And Selection.End = ActiveDocument.Content.End – 1 Then
Petla = 0
End If

Wend
End Sub

Jeśłi są jakieśuwagi lub błędy to czekam na opinie...
Pozdrawiam

Mi to makro nie działa
RUN–TIME ERROR '5941'
źądane element kolekcji nie istnieje

PO naciśnięciu debug wskazuje linię

linie$ = ActiveDocument.Bookmarks("line").Range.Text

Co trzeba poprawić?

Dzięki za pomoc!
Obawiałem się, źe tę sprawę moźna załatwić tylko poprzez makro... :cry:
Ale, źe sam nie znalazłem tych wątków to wstyd :oops:
Pozdrawiam
kierofca

http://forum.centrumxp.pl/viewtopic.php?t=16470&highlight=