---

Bild1.jpg Bild2.jpg Excel.jpg

Hallo zusammen,

ich schon wieder.     

oh je, das tut mir leid! Die Fehlermeldung lautet keines der ausgewählten Elemente konnte gelöscht werden.

Ich habe mein Makro auf SW-Basis so gut wie fertig, allerdings löscht er mir alle übrigen Muffen bis auf die M8er... (siehe Bild 1 und 2)
Der folgende Code müsste theoretisch daran Schuld sein, und ich weiß nicht warum...

'---------------------------------------------------------
'untere Zeile in der Benutzeroberfläche des Konfigurators
'---------------------------------------------------------
l = 5       'Zählvariable um im Namen der Muffe zu variieren.
For i = 3 To 11
    If objSource.cells(45, i) <> "" Then
        For j = 1 To 25
            If objSource.cells(45, i) = xl.worksheets("Muffen").cells(j, 1) Then 'Muffe aus Tabellenblatt Muffen suchen
                Zeile = j   'Zeile, in welcher die Muffe beschrieben wird, speichern
                Exit For
            End If
        Next j
       
        Select Case objSource.cells(43, i)  'Unterscheidung zwischen Mantel, Boden oben und Boden unten
        Case Is = "Mantel"
            'Änderung des Excel-Tabellenblattes im Case, da sonst die Select Case-Abfrage nicht mehr funktioniert.
            Set objSource = xl.worksheets("Muffen")
           
            'Prüfen, ob kein Bauteil geöffnet ist
            If Part3 Is Nothing Then
                Name3 = "X:\Technikerarbeit\3D_Teile\M" & (l) & "_Mantel.SLDPRT"    'Pfad für die jeweilige Muffe
                Set Part3 = swApp.OpenDoc6(Name3, swDocPart, swOpenDocOptions_Silent, "", Errors, Warnings) 'Öffnen des Bauteils
            End If
       
            ' #####  Bearbeitung Muffe
            Set myD3 = Part3.Parameter("D1@Skizze1")    'Höhe der Muffe
            myD3.SystemValue = objSource.cells(Zeile, 4) / 1000 'Maßübergabe an die betreffende Adresse
            'swApp.SendMsgToUser (objSource.cells(Zeile, 4)) 'Kontrollbox zur Sicherstellung der Maßübertragung

            Set myD3 = Part3.Parameter("IDurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 6) / 1000

            Set myD3 = Part3.Parameter("ADurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 2) / 1000

            Set myD3 = Part3.Parameter("Fasendurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 7) / 1000

            Set myD3 = Part3.Parameter("Fasenhöhe@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 8) / 1000

            Part3.ClearSelection2 True          'Alle eventuell bestehenden Referenzen löschen
            Part3.Save3 1, Errors, Warnings     'Bauteil speichern
            swApp.CloseDoc Name3                'Bauteil schließen
           
            'analoge Muffe im Boden oben löschen
            Name3 = "M" & l & "_Boden_o-1@Standardbehälter"
            Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
            Part4.EditDelete
           
            'analoge Muffe im Boden unten löschen
            Name3 = "M" & l & "_Boden_u-1@Standardbehälter"
            Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
            Part4.EditDelete

        Case Is = "Boden oben"
            Set objSource = xl.worksheets("Muffen")     'Änderung des Excel-Tabellenblattes
           
            'Prüfen, ob kein Bauteil geöffnet ist.
            If Part3 Is Nothing Then
                Name3 = "X:\Technikerarbeit\3D_Teile\M" & (l) & "_Boden_o.SLDPRT"    'Pfad für die jeweilige Muffe
                Set Part3 = swApp.OpenDoc6(Name3, swDocPart, swOpenDocOptions_Silent, "", Errors, Warnings) 'Öffnen des Bauteils
            End If

            ' #####  Muffe im Boden ändern
            Set myD3 = Part3.Parameter("D1@Skizze1")    'Höhe der Muffe
            myD3.SystemValue = objSource.cells(Zeile, 4) / 1000 'Maßübergabe an die betreffende Adresse
            'swApp.SendMsgToUser (objSource.cells(Zeile, 4)) 'Kontrollbox zur Sicherstellung der Maßübertragung

            Set myD3 = Part3.Parameter("IDurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 6) / 1000

            Set myD3 = Part3.Parameter("ADurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 2) / 1000

            Set myD3 = Part3.Parameter("Fasendurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 7) / 1000

            Set myD3 = Part3.Parameter("Fasenhöhe@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 8) / 1000

            Part3.ClearSelection2 True          'Alle eventuell bestehenden Referenzen löschen
            Part3.Save3 1, Errors, Warnings     'Bauteil speichern
            swApp.CloseDoc Name3                'Bauteil schließen

            'analoge Muffe im Mantel löschen
            Name3 = "M" & l & "_Mantel-1@Standardbehälter"
            Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
            Part4.EditDelete

            'analoge Muffe im Boden unten löschen
            Name3 = "M" & l & "_Boden_u-1@Standardbehälter"
            Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
            Part4.EditDelete

        Case Is = "Boden unten"
            Set objSource = xl.worksheets("Muffen")     'Änderung des Excel-Tabellenblattes
           
            'Prüfen, ob ein Bauteil bereits geöffnet ist
            If Part3 Is Nothing Then
                Name3 = "X:\Technikerarbeit\3D_Teile\M" & (l) & "_Boden_u.SLDPRT"    'Pfad für die jeweilige Muffe
                Set Part3 = swApp.OpenDoc6(Name3, swDocPart, swOpenDocOptions_Silent, "", Errors, Warnings) 'Öffnen des Bauteils
            End If
           
            ' #####  Muffe im Boden ändern
            Set myD3 = Part3.Parameter("D1@Skizze1")    'Höhe der Muffe
            myD3.SystemValue = objSource.cells(Zeile, 4) / 1000 'Maßübergabe an die betreffende Adresse
            'swApp.SendMsgToUser (objSource.cells(Zeile, 4)) 'Kontrollbox zur Sicherstellung der Maßübertragung

            Set myD3 = Part3.Parameter("IDurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 6) / 1000

            Set myD3 = Part3.Parameter("ADurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 2) / 1000

            Set myD3 = Part3.Parameter("Fasendurchmesser@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 7) / 1000

            Set myD3 = Part3.Parameter("Fasenhöhe@Skizze1")
            myD3.SystemValue = objSource.cells(Zeile, 8) / 1000
           
            Part3.ClearSelection2 True          'Alle eventuell bestehenden Referenzen löschen
            Part3.Save3 1, Errors, Warnings     'Bauteil speichern
            swApp.CloseDoc Name3                'Bauteil schließen
           
            'analoge Muffe im Mantel löschen
            Name3 = "M" & l & "_Mantel-1@Standardbehälter"
            Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
            Part4.EditDelete

            'analoge Muffe im Boden oben löschen
            Name3 = "M" & l & "_Boden_o-1@Standardbehälter"
            Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
            Part4.EditDelete
           
        End Select
        l = l + 1 'Zählvariable für den Index im Bauteilnamen
        Set objSource = xl.worksheets("Konfigurator")     'Änderung des Excel-Tabellenblattes
    Else
        k = l
        Do Until objSource.cells(41, k) = ""
                'übrige Muffen im Mantel löschen
                Name3 = "M" & l & "_Mantel-1@Standardbehälter"
                Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                Part4.EditDelete

                'analoge Muffe im Boden oben löschen
                Name3 = "M" & l & "_Boden_o-1@Standardbehälter"
                Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                Part4.EditDelete

                'analoge Muffe im Boden unten löschen
                Name3 = "M" & l & "_Boden_u-1@Standardbehälter"
                Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
                Part4.EditDelete
        k = k + 2
        Loop
'        For k = i To 11
'            If objSource.cells(41, k) <> "" Then
'                'übrige Muffen im Mantel löschen
'                Name3 = "M" & l & "_Mantel-1@Standardbehälter"
'                Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
'                Part4.EditDelete
'
'                'analoge Muffe im Boden oben löschen
'                Name3 = "M" & l & "_Boden_o-1@Standardbehälter"
'                Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
'                Part4.EditDelete
'
'                'analoge Muffe im Boden unten löschen
'                Name3 = "M" & l & "_Boden_u-1@Standardbehälter"
'                Status = Part4.Extension.SelectByID2(Name3, "COMPONENT", 0, 0, 0, False, 0, Nothing, 0)
'                Part4.EditDelete
'            Else
'                Exit For
'            End If
'            k = k + 1
'        Next k
    End If
    i = i + 1
Next i

Manuell lassen sich die Muffen löschen.

Hintergrundinfo: Die Werte bekommt das SW-Makro aus einer Excel-Tabelle (siehe Bild) und wenn in den Spalten nichts steht, dann soll er die Muffe löschen.

Zur Zeit gehe ich davon aus, dass das Problem im Code nach dem zweitletzten Else liegt, also die äußere If-Bedingung. Deshalb auch die auskommentierte Variante, aber an dieser lag es leider nicht...

Hoffentlich könnt ihr mir weiterhelfen.

Lieben Gruß,
Kristina

[Diese Nachricht wurde von Thunja am 30. Aug. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich habe nochmals etwas rumprobiert und in der ersten Muffenzeile, sowie auch in der zweiten Muffenzeile meines Excel-Dokuments fast alle Muffen gelöscht, sodass nur noch in der ersten Zeile Muffe M1 und M2 ausgefüllt waren und in der zweiten Zeile keine mehr standen.
Ergebnis war, dass das Makro die Do-Until-Schleife 1x durchläuft und das macht, was es soll. In jedem weiteren Durchlauf bringt es die oben genannte Meldung.

Vielleicht hilft das ja nochmal weiter.

Vielen Dank für das Befassen mit meinem Beitrag.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

im Trockendurchlauf etwas schwierig zu sagen ... 

du hast am Ende eine Schleife über "k", benutzt aber weiter "i" für die Namensbildung.
kann es sein, dass deshalb versucht wird, Elemente zu löschen, die schon weg sind?

Gruß, Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Christian,

ich denke, dass die Annahme falsch ist, da ich im Anschluss an das Makro die Muffen händisch löschen kann. Sie sind also auf jeden Fall noch da.

Darüber hinaus hast du den kommentierten Teil analysiert. 

Gruß,

Kristina

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

dann korrigiere ich:
du hast am Ende 2 (in Worten zwei) Schleifen über k.
- do ... loop (aktiv)
- for ... next (auskommentiert)
und nun?

in beiden wird name3 aus "M" & I & .... zusammengesetzt.
das I verändert sich aber nicht mehr.

ansonsten würde ich mal ein debug.print name3 vor die Löschbefehle setzen.
Dann siehst du was der Befehl da löschen soll.

Gruß, Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Also ich halte es erst mal für grundsätzlich falsch, innerhalb der Schleife:

For i = 3 To 11
...
Next i

nochmal das i mittels i = i + 1 hochzuzählen.

Im Moment bin ich mir sogar unsicher, wie oft dieser Loop dann konkret durchlaufen wird, und ich möchte es auch nicht ausprobieren, da das extrem (nennen wir es höflich 'ungewöhnlich' ist.
Bist Du Dir an dieser Stelle wirklich sicher, was Du da tust?

Ansonsten ist Christians Vorschlag sicher zielführend.
Man könnte vor dem Löschbefehl auch noch ein:
If Status = True Then
einfügen.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Christian,

ich muss wohl zurück rudern...
Ich habe den Wald vor lauter Bäumen nicht mehr gesehen. Liegt vielleicht daran, dass ich kaum noch etwas anderes als dieses Makro vor Augen habe.
Es tut mir jedenfalls Leid, beim ersten Mal nicht richtig "zugehört" zu haben.
Du hattest vollkommen Recht, egal in welcher Schleife.
Das wird nicht wider vorkommen.

@Torsten:
Ja, ich weiß, was ich da mache.  Wenn auch nicht immer fehlerfrei.

Zum Makro: i zählt die Spalten in der Excel-Tabelle. Es wird aber am Ende immer um 2 erhöht, weil jede zweite Zelle durch Verbund an die erste "geheftet" wurde und deshalb leer ist.
l ist dazu da, um die Muffennummerierung richtig auszuwählen.

Vielen Dank für eure  konstruktiven Antworten.

Lieben Gruß,

Kristina

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

üblicher Weg: Verwendung von Step

https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/statements/for-next-statement

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke für den Hinweis, Torsten.

Ich werde mich im Nachhinein da nochmal etwas einarbeiten.
Im Moment geht es vorrangig aber um die heutige Präsentation, sodass ich jetzt nicht noch Code rumschreibe, welcher bereits läuft.

Gruß,
Kristina

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

...
ich muss wohl zurück rudern...
Ich habe den Wald vor lauter Bäumen nicht mehr gesehen. Liegt vielleicht daran, dass ich kaum noch etwas anderes als dieses Makro vor Augen habe.
...

---

Hallo Kristina,

rudere ruhig weiter voran 
Hauptsache es war dann auch der Fehler ... den Wald kennen wir wohl alle 

das i+1 hat mich auch kurz irritiert - Torstens Vorschlag "step 2" ist da sicher leichter zu lesen.

Wenn du dir debug.print einbaust, kannst du in der Umgebung besser beobachten, was im Hintergrund tatsächlich passiert ist. Oft machen diese blöden Computer ja genau was wir geschrieben haben, nicht was wir denken geschrieben zu haben...

Gruß, Christian

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP