Abstürze X6 nach Makroausführung

[koter]

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