Ebenen zusammenführen

[koter]

Hallo Günther,

wenn „qKopieren“ ausgeführt wird, ohne dass etwas ausgewählt ist,
kann CorelDraw einfrieren oder komplett abstürzen.

Du solltest deshalb „qKopieren“ und „qEinfügen“ durch folgendes austauschen:

Code:

Sub qKopieren()
   Dim HRe As Shape
   On Error GoTo ende
   If ActiveSelectionRange.Count <> 1 Then
       MsgBox "Bitte ein Objekt auswählen!", vbExclamation, "Kopieren"
       Exit Sub
   End If
   Optimization = True
   Set HRe = Hilfsrechteck(Quadrant(ActiveShape))
   markieren
   QuellgruppeErzeugen
   kopieren
   HRe.Delete
   QuellgruppeVerteilen
ende:
   Optimization = False
   Application.Refresh
   Refresh
End Sub

Sub qEinfügen()
   Dim QGr As Shape, HRe As Shape
   Dim q1 As Integer, q2 As Integer
   On Error GoTo ende
   q2 = quadrantKlick
   Set QGr = ActiveLayer.Paste
   Optimization = True
   Select Case q2
   Case 1
       QGr.LeftX = 0
       QGr.TopY = ActivePage.TopY
   Case 2
       QGr.RightX = ActivePage.RightX
       QGr.TopY = ActivePage.TopY
   Case 3
       QGr.LeftX = 0
       QGr.BottomY = 0
   Case 4
       QGr.RightX = ActivePage.RightX
       QGr.BottomY = 0
   End Select
   Set HRe = QGr.Shapes("Hilfsrechteck")
   q1 = HRe.Properties("Quadrant", 1)
   If q1 = 1 Xor q1 = 3 Then
       If q2 = 2 Or q2 = 4 Then QGr.Rotate 180
   Else
       If q2 = 1 Or q2 = 3 Then QGr.Rotate 180
   End If
   HRe.Delete
   QuellgruppeVerteilen
ende:
   Optimization = False
   Application.Refresh
   Refresh
End Sub

Vor der Ausführung wird geprüft, ob etwas ausgewählt ist. Wenn nicht bricht die Funktion ab.
So ist das etwas sicherer, man klickt ja schnell mal zu früh.

Gruß

Koter