Abstürze X6 nach Makroausführung
#6
Hallo Thorsten, hallo Norre,

ich kann nur raten, weil ich X6 nicht besitze:

Das Makro greift auf den Programmstatus und damit auch auf die Statusleiste zu,
um dem Benutzer die Möglichkeit zu bieten, das Makro durch einen Druck auf die Escape-Taste zu unterbrechen.
Außerdem zeigt es einen Fortschrittsbalken in der Statusleiste an.

Um den Ablauf zu beschleunigen, werden die Funktionen boostStart und boostFinish aufgerufen.

Da es bei X6 ein Problem mit der Statusleiste zu geben scheint, sollte man den Zugriff des Makros auf dieselbe vielleicht mal „abschalten“.

Es kann auch möglich sein, dass boostStart und boostFinish Probleme machen.

Im folgenden Code-Beispiel sind diese Funktionen auskommentiert (abgeschaltet):

Code:
Option Explicit

Sub removeUnderlyingDups()
   Dim s As Shape, sr As New ShapeRange, props() As Double
   Dim toDel As New ShapeRange, stat As AppStatus, Jitter As Double, cnt&, idx&, _
       x As Double, y As Double, w As Double, h As Double, n&, match%, i&
   Jitter = 0.0001
   On Error Resume Next
   If ActiveSelectionRange.Count = 0 Then Set sr = ActivePage.FindShapes _
      Else Set sr = ActiveSelectionRange.Shapes.FindShapes
   If sr.Count = 0 Then Exit Sub
   ReDim props(1 To sr.Count, 1 To 5): cnt = 0: idx = 0
   'Set stat = Application.Status'                                  auskommentiert
   'stat.BeginProgress "Looking for curve duplicates...", True'     auskommentiert
   'boostStart'                                                     auskommentiert
   For Each s In sr
      'idx = idx + 1: stat.Progress = idx / sr.Count * 100'         auskommentiert
      'If stat.Aborted Then Exit For'                               auskommentiert
      x = s.PositionX: y = s.PositionY: n = s.DisplayCurve.Nodes.Count
      w = s.SizeWidth: h = s.SizeHeight: match = False
      If w < Jitter And h < Jitter Then
         toDel.Add s: cnt = cnt + 1
      Else
         For i = 1 To cnt
            'If stat.Aborted Then Exit For'                         auskommentiert
            If Abs(props(i, 1) - x) < Jitter Then _
               If Abs(props(i, 2) - y) < Jitter Then _
                  If Abs(props(i, 3) - w) < Jitter Then _
                     If Abs(props(i, 4) - h) < Jitter Then _
                        If props(i, 5) = n Then _
                           toDel.Add s: match = True: Exit For
         Next i
         If Not match Then
            cnt = cnt + 1: props(cnt, 1) = x: props(cnt, 2) = y
            props(cnt, 3) = w: props(cnt, 4) = h: props(cnt, 5) = n
         End If
      End If
   Next s
   'boostFinish'                                                    auskommentiert
   If toDel.Count = 0 Then Exit Sub
   toDel.CreateSelection
   If MsgBox("Confirm delete " + CStr(toDel.Count) + " objects", vbOKCancel) = vbOK Then _
      toDel.Delete
End Sub

Vielleicht klappt es auf diese Weise mit X6

Nachtrag: Man kann das Makro so natürlich nicht mehr mit der Escape-Taste unterbrechen.

Gruß

Koter
[-] 1 Benutzer bedankt sich bei koter für diesen Beitrag:
  • Unkraut
Zitieren



Nachrichten in diesem Thema
Abstürze X6 nach Makroausführung - von norre - 30.01.2014, 13:25
Abstürze X6 nach Makroausführung - von norre - 30.01.2014, 16:23
Abstürze X6 nach Makroausführung - von norre - 30.01.2014, 17:51
Abstürze X6 nach Makroausführung - von koter - 31.01.2014, 08:59
Abstürze X6 nach Makroausführung - von norre - 31.01.2014, 09:04
Abstürze X6 nach Makroausführung - von norre - 31.01.2014, 09:14
Abstürze X6 nach Makroausführung - von koter - 31.01.2014, 09:29
Abstürze X6 nach Makroausführung - von norre - 31.01.2014, 09:36

Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Fragmente in Schrift nach export in *.ai peterjaeckel 8 976 10.07.2025, 13:21
Letzter Beitrag: m.ster
  Sortierung nach Füllungsfarben Boerni 11 1.877 19.04.2025, 07:04
Letzter Beitrag: Boerni
  PDF nach importieren, automatisch verändert sebastian84 4 724 06.04.2025, 21:20
Letzter Beitrag: mvm
  Nach Update Abo-Version keine Vorschau mehr niereeck 0 353 02.04.2025, 12:12
Letzter Beitrag: niereeck
  Neuinstallation von Corel DRAW X5 nach einem Crash Bronimus 1 567 08.02.2025, 09:49
Letzter Beitrag: Bronimus
  Upgrade von CD 2019 auf 2024 => Abstürze Anselm 0 649 28.05.2024, 19:00
Letzter Beitrag: Anselm
  Corel Draw - Schrift Quicksand nach Umwandeln in Kurven nicht plottbar annalotta 1 2.085 15.02.2024, 13:57
Letzter Beitrag: Piet
  vorlage nach pixelgröße erstellen panzerauto 1 1.030 11.05.2023, 12:16
Letzter Beitrag: Karthagos
Photo Kreis erhält nach Export über Makro als DXF sehr viele Knotenpunkte Olaf 4 2.159 22.06.2022, 08:34
Letzter Beitrag: Olaf
  Kontur nach dem Export in PDF nicht mehr 100 % schwarz Ueckendorf 6 2.657 23.11.2021, 21:28
Letzter Beitrag: mvm