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