Corel FORUM

[kadoesdoi]

Hej Wszystkim

Próbowałem zrobić skrypt i makro który zmniejszałby obiekt m. in. o 4%.
Niestety okazało się, że na innych obiektach nie działa poprawnie ponieważ mimo że wpisywałem 96% w polu procentowym to skrypt zapamiętuję rozmiar obiektu a nie to o ile procent zmniejszyłem obiekt.

Czy jest możliwość stworzenia takiego skryptu?

[kek]

Witam.
Ale po co skrypt?
Wystarczy, że zaznaczysz obiekt, a następnie w oknie "Współczynnik skalowania" wpiszesz o ile chcesz zmniejszyć/zwiększyć dany obiekt.
Np. w oknie masz 100% dopisujesz -4 (100-4), i obiekt zmniejszy się o 4%.
Jeśli w oknie masz inną liczbę niż 100, to dorysuj w obiekcie jakiś kwadracik, który późnij wykasujesz, i później zaznaczając całość masz w okienku procentów 100. Dalej postępujesz jak na początku pisałem, a na koniec usuwasz dodany element i gotowe.

[kadoesdoi]

Hej.

I tak teraz pracuję. :)

Mam trzy stałe wartości które się powtarzają w mojej pracy.
Chciałbym mieć skrypt do każdej z nich aby ustawić skróty klawiaturowe.

W zaawansowanej formie chciałbym, aby skrypt obiekt z pierwszej strony skopiował na druga i zmniejszył o 4 lub 15%, a oryginał z pierwszej zmniejszył o 73 % i zmienił położenie, dopasowując grafikę do wizualizacji. :)

Nie wiem w ogóle czy to jest możliwe, ale taki chciałbym skrypt.
Póki co zatrzymałem się na procentowym zmniejszaniu.

[kadoesdoi]

Hej

Informatyk z mojej pracy chcąc pomóc podesłał taki skrypt, ale coś nie działa.
Macie może pomysł dlaczego?


VBA script dla CorelDraw

Sub ResizePercentage(percentage As Double)
Dim sel As Selection
Set sel = ActiveSelectionDim obj As Shape
For Each obj In sel
Dim newWidth As Double
newWidth = obj.Width * (percentage / 100)
Dim newHeight As Double
newHeight = obj.Height * (percentage / 100)

' Resize the object
obj.SetSize newWidth, newHeight
Next
End Sub


Pozdro.

[Martin Nez]

Witam,
spróbuj tego - nie jest to rozwiązanie Twojego problemu z resetowaniem pola procentowego, ale chyba nada się do tego co chcesz stworzyć.

Kod:

Sub test()     ksi 90 End Sub Sub ksi(procent As Double)     ActiveSelection.SetSize ActiveSelection.SizeWidth * (procent / 100), 0# End Sub

Pozdr,
MN

[krof]

Sub nowa_warstwa()
' Tworzenie nowej warstwy
Dim la2
la2 = "Warstwa-4%" 'Nazwa warstwy

Set newLayer = ActiveDocument.ActivePage.CreateLayer(la2)
If ActiveSelectionRange.Shapes.Count = 0 Then
MsgBox "Nie zaznaczono obiektów do przeskalowania", 16, "Uwaga"

Else
'kopiowanie z warstwy podstawowej do warstyw la2
Set sr = ActiveSelectionRange
sr.Copy
newLayer.Paste

'przeskalowanie obiektu na warstwie la2
Set sr1 = newLayer.Shapes.All

sr1.SizeHeight = sr1.SizeHeight * 1.04
sr1.SizeWidth = sr1.SizeWidth * 1.04

MsgBox "Wykonano"
End If

End Sub

Teraz można się bawić dalej dodać jeszcze jedną warstwę, jakieś dodatkowe fajerwerki np.sprawdzanie czy warstwa o takiej nazwie już isnieje.