Corel FORUM

N0carz

Witam.

W związku z tym, że ostatnim czasem dość często muszę ułożyć tekst w kilkustronicowym projekcie za pomocą Korka to poszukuje makro, które zamieni spację po sierotkach w tekstach na twardą spacje. Na razie radzę sobie za pomocą funkcji znajdź/zamień. Ale jest to dość uciążliwe gdyż trzeba każdą potencjalną sierotkę wpisać ręcznie (duża i mała litera) oraz jednostki miary. Niestety kiedy goni czas tym sposobem łatwo o czymś zapomnieć, a co gorzej łatwo jest przeoczyć i zamienić literki np. wyszukać "i" zamieniając ją na literkę "a":/. Spróbowałem nagrać Makro z tej czynności ale niestety Korek nie potrafi przełożyć tej operacji z wyszukiwania tekstu na kod źródlowy zostawiając w edytorze jedynie taki tekst "Recording of this command is not supported: TextEdit". Przeszukałem internet i pod kątem gotowych makr do zamiany tekstu a konkretnie do pozbycia się sierot uzyskałem dość skąpe rezultaty (o dziwo, gdyż jest to chyba dość znany problem z Corelem). Poniżej kilka znalezionych makr, wymagały by dopracowania:

Tu za pomocą okna dialogowego mogę sam wpisać który tekst chce zmienić oraz tekst na na który chce zmienić, ale niestety nie działają znaczniki twardej spacji więc nie do końca się sprawdza

Kod:

Sub test()
Dim txtFIND As String 'wpisać tekst do zmiany
Dim txtREPLACE As String 'wpisać tekst na który zmienić

Dim d As Document
Dim p As Page
Dim s As Shape

txtFIND = InputBox("Enter the string you wish to replace:", "Replace Text Across OpenDocs")
txtREPLACE = InputBox("Enter the new string:", "Replace Text Across OpenDocs")

For Each d In Documents 'Loop all the open documents
For Each p In d.Pages 'Loop each page
p.TextReplace txtFIND, txtREPLACE, True, False
Next p
Next d
End Sub

Tu teks wyszukiwany i zmieniany jest przedefiniowany w kodzie ale też nie działają znaczniki rodzaju spacji więc również nie działa.

Kod:

Sub test()
Const txtFIND As String = "tekst" 'tekst wyszukiwany
Const txtREPLACE As String = "tekst2" 'zmienić na

Dim d As Document
Dim p As Page

For Each d In Documents 'Loop all the open documents
For Each p In d.Pages 'Loop each page
p.TextReplace txtFIND, txtREPLACE, True, False
Next p
Next d
End Sub

Moje pytanie czy ktoś takie makro o które mi chodzi posiada w swoich zasobach by się nim podzielić? Jeśli nikt nie ma to proszę o pomoc. Może ktoś bardziej biegły w pisaniu makr do corela byłby wstanie na podstawie wyżej podanych skryptów bądź od nowa zrobić makro o które mi chodzi? Sam trochę znam się na VBA, ale nigdy nie siedziałem w kodowaniu do Corela jedynie pod produkty MS OFFICE, a jak się nie zna środowiska i jak się nazywają składniki do których trzeba się odwołać to ciężko jest cokolwiek ugrać:/ Takie makto zapewne uprościło by pracę mi i wielu innym użytkownikom tego forum. Dzięki.

tegraf

Jak wpisujesz twardą spację w makro nr 1?

N0carz

tak jak przy wyszukiwaniu <Non-breaking Space> i też próbowałem kod &0146 (nie pamiętam dokładnie) który, gdzieś zobaczyłem przeszukując internet.

tegraf

Alt + 0160 na klawiaturze numerycznej

N0carz

Właśnie w trakcie jak odpisałeś kombinowałem z tym skrótem tylko wpisywałem go do kody jako tekst a nie wpadłem na to by po prostu wpisać:D Po wklepaniu wo kodu działa na literce a. jak przerobię całość i będzie działać wkleje tu kod:D

Dzięki wielkie

tegraf

Kod:

Sub test()

Dim d As Document
Dim p As Page
Dim s As Shape
Dim x As Integer
Dim myFindArray

myFindArray = Array("a", "i", "o", "u", "w", "z")

For Each d In Documents 'Loop all the open documents
For Each p In d.Pages 'Loop each page
For x = 0 To 5
p.TextReplace myFindArray(x) & " ", myFindArray(x) & " ", True, False
p.TextReplace UCase(myFindArray(x)) & " ", UCase(myFindArray(x)) & " ", True, False
Next
Next p
Next d
End Sub

W 5 i 6 wierszu od dołu, w drugich nawiasach jest twarda spacja: Alt + 0160

N0carz

Zrobiłem na szybko takie coś :-P

:) Wiem zupełnie nie optymalny i brzydki kod... pewnie paru programistów jak zobaczy to padnie na zawał pozostali padną śmiechem ale grunt, że działa. Niech ktoś bardziej kumaty w te klocki zoptymalizuje ten kod po swojemu :mrgreen:

Uzupełniłem wyszukiwanie w podstawowe jednostki miar

Kod:

Sub test2()
Const bigA As String = " A " 'wyszukiwanie wielkiej literki A
Const replace_bigA As String = " A "
Const smA As String = " a "
Const replace_smA As String = " a "

Const bigI As String = " I " 'wyszukiwanie wielkiej literki I
Const replace_bigI As String = " I "
Const smI As String = " i "
Const replace_smI As String = " i "

Const bigO As String = " O " 'wyszukiwanie wielkiej literki O
Const replace_bigO As String = " O "
Const smO As String = " o "
Const replace_smO As String = " o "

Const bigU As String = " U " 'wyszukiwanie wielkiej literki U
Const replace_bigU As String = " U "
Const smU As String = " u "
Const replace_smU As String = " u "

Const bigW As String = " W " 'wyszukiwanie wielkiej literki W
Const replace_bigW As String = " W "
Const smW As String = " w "
Const replace_smW As String = " w "

Const bigZ As String = " Z " 'wyszukiwanie wielkiej literki Z
Const replace_bigZ As String = " Z "
Const smZ As String = " z "
Const replace_smZ As String = " z "

Const bigKM As String = " KM " 'wyszukiwanie wielkiej literki KM
Const replace_bigKM As String = " KM "
Const smKM As String = " km "
Const replace_smKM As String = " km "

Const bigM As String = " M " 'wyszukiwanie wielkiej literki M
Const replace_bigM As String = " M "
Const smM As String = " m "
Const replace_smM As String = " m "

Const bigCM As String = " CM " 'wyszukiwanie wielkiej literki CM
Const replace_bigCM As String = " CM "
Const smCM As String = " cm "
Const replace_smCM As String = " cm "

Const bigMM As String = " MM " 'wyszukiwanie wielkiej literki MM
Const replace_bigMM As String = " MM "
Const smMM As String = " mm "
Const replace_smMM As String = " mm "

Const bigL As String = " L " 'wyszukiwanie wielkiej literki L
Const replace_bigL As String = " L "
Const smL As String = " l "
Const replace_smL As String = " l "

Const bigML As String = " ML " 'wyszukiwanie wielkiej literki ML
Const replace_bigML As String = " ML "
Const smML As String = " ml "
Const replace_smML As String = " ml "

Const bigKG As String = " KG " 'wyszukiwanie wielkiej literki KG
Const replace_bigKG As String = " KG "
Const smKG As String = " kg "
Const replace_smKG As String = " kg "

Const bigG As String = " G " 'wyszukiwanie wielkiej literki G
Const replace_bigG As String = " G "
Const smG As String = " g "
Const replace_smG As String = " g "

Dim d As Document
Dim p As Page

For Each d In Documents 'przeszukuje dokument
For Each p In d.Pages 'przeszukuje strone
p.TextReplace bigA, replace_bigA, True, False
p.TextReplace smA, replace_smA, True, False
p.TextReplace bigI, replace_bigI, True, False
p.TextReplace smI, replace_smI, True, False
p.TextReplace bigO, replace_bigO, True, False
p.TextReplace smO, replace_smO, True, False
p.TextReplace bigU, replace_bigU, True, False
p.TextReplace smU, replace_smU, True, False
p.TextReplace bigW, replace_bigW, True, False
p.TextReplace smW, replace_smW, True, False
p.TextReplace bigZ, replace_bigZ, True, False
p.TextReplace smZ, replace_smZ, True, False
p.TextReplace bigKM, replace_bigKM, True, False
p.TextReplace smKM, replace_smKM, True, False
p.TextReplace bigM, replace_bigM, True, False
p.TextReplace smM, replace_smM, True, False
p.TextReplace bigCM, replace_bigCM, True, False
p.TextReplace smCM, replace_smCM, True, False
p.TextReplace bigMM, replace_bigMM, True, False
p.TextReplace smMM, replace_smMM, True, False
p.TextReplace bigL, replace_bigL, True, False
p.TextReplace smL, replace_smL, True, False
p.TextReplace bigML, replace_bigML, True, False
p.TextReplace smML, replace_smML, True, False
p.TextReplace bigKG, replace_bigKG, True, False
p.TextReplace smKG, replace_smKG, True, False
p.TextReplace bigG, replace_bigG, True, False
p.TextReplace smG, replace_smG, True, False
Next p
Next d
End Sub

N0carz

tegraf

Tak, wystarczy.

Jednak nie wystarczy.

Trzeba dopisać duże litery + jednostki miar oraz usunąć 5 wiersz od dołu - inaczej niektóre jednostki zostaną zamienione błędnie na wielkoliterowe, np. kB na KB.

Poprawię wieczorem.

N0carz

N0carz