kadoesdoi - 30 Listopad 2022, 14:03 Temat postu: Makro zmiany rozmiaru wg % 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 - 1 Grudzień 2022, 08:37 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 - 1 Grudzień 2022, 12:13 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 - 6 Styczeń 2023, 10:16 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 - 4 Marzec 2023, 01:47 Witam, spróbuj tego - nie jest to rozwiązanie Twojego problemu z resetowaniem pola procentowego, ale chyba nada się do tego co chcesz stworzyć.
Pozdr, MN krof - 5 Grudzień 2023, 14:55 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. |
