Corel FORUM

[TheMan258]

Witam wszystkich,
Potrzebuję porady, pracuje w Corelu x5 i mam napisane różne makra, z których korzystam, na co dzień. Mam makro, które rozdziela obiekty na osobne warstwy następnie je sobie rozgrupowuję i np. zmieniam coś w tej rozgrupowanej grupie. I tu mam problem, ponieważ potrzebowałbym takie makro, które zgrupuje wszystkie te obiekty, ale w taki sposób, aby te kształty zostały w swoich warstwach tak jak w załączniku. (Makro które grupuje obiekty wewnątrz warstw)
Mam takie makro, ale działa tylko wtedy gdy warstwa nazywa się ,,Warstwa 1,,.
Nie wiem, czy dobrze myślę, ale próbowałem coś takiego dopisać

Kod:

( "Warstwa_" &)

jednak to nie działa.

Kod:

Sub Grupowanie()     Dim sr As ShapeRange, s As Shape     Set sr = ActivePage.Layers("Warstwa 1").Shapes.All     If sr.count = 0 Then MsgBox "Żaden kształt nie jest zaznaczony": Exit Sub     Set s = sr.Group End Sub

Czasem mam 100 warstw z kształtami i zajmuje mi to trochę czasu zgrupować te wszystkie obiekty. Byłbym bardzo wdzięczny o wskazanie sposobu, w jaki sposób taką operację przeprowadzić.

---

Warstwy.jpg

Pobierz Plik ściągnięto 348 raz(y) 638.98 KB

[maroQ]

Rozumiem, że używasz pętli dla warstw. W takim przypadku należy jeszcze aktywować warstwę na której się operuje w przeciwnym wypadku zawsze pracujemy na aktywnej. Alternatywnie po zgrupowaniu można obiekty przenieść na inną warstwę.

Kod:

Sub GroupAllOnPage()     Dim sr As ShapeRange, s As Shape     Dim l As Layer     Dim info As String         For Each l In ActivePage.Layers         If l.IsDesktopLayer Or l.IsSpecialLayer Or l.IsGridLayer Or l.IsGuidesLayer Or l.Editable = False Then             GoTo skip         End If         l.Activate                 Set sr = l.Shapes.All         If sr.Count = 0 Then             info = info & "Na warstwie " & l.Name & " nie znaleziono obiektow!" & vbNewLine         ElseIf sr.Count = 1 Then             If sr.Item(1).Type = cdrGroupShape Then                 info = info & "Obiekty na warstwie " & l.Name & " zostaly uprzednio zgrupowane" & vbNewLine             Else                 info = info & "Na warstwie " & l.Name & " byl tylko jeden obiekt wiec nie zostal zgrupowany" & vbNewLine             End If         Else             Set s = sr.Group             info = info & "Zgrupowano " & sr.Count & " krzywych na warstwie " & s.Layer.Name & vbNewLine             's.MoveToLayer l         End If skip:     Next l

W edytorze VBA odpal CTRL+G lub Immediate Windows z menu View by zobaczyć konsolę.

Makro pomija warstwy specjalne oraz nieedytowalne.

Linijka: Set s = sr.Group jest zbędna gdyż sr.Group nie wymaga przypisania do zmiennej. Jednak zostawiłem ją dla celów diagnostycznych by podglądać na jakiej warstwie leży nasz kształt s.

[TheMan258]

Dziękuję bardzo, makro wspaniale działa