---

Hi,

ich hab ein kleines VBA-Makro (ich glabu, denn hab ich hier irgendwo gefunden), dass mir in einer Drawing nach einem Textfeld-Namen sucht und dieses dann lösht. Das funktiniert soweit auch super, nur hab ich jetzt das Problem, das wenn das Textfeld auf Blatt 01 und Baltt 02 vorhanden ist, dieses auf beiden gelöscht wird. Es soll aber nur von dem aktiven Blatt gelöscht werden. Das Textfeld befindet sich im Backround.

Code:

---

Public Function DeletTxtFeld(varTextfeldName As String)

    Dim intDocObj As Document
    Dim intWindowsObj As Windows
    Dim intObjTypeStr As String
    Dim intTextBoxNameStr As String
   
    intTextBoxNameStr = varTextfeldName
   
   
    '***Background View zugänglich machen
    Dim intSheetObj As DrawingSheet
    Dim intBckViewObj As DrawingView
   
    Set intDocObj = CATIA.ActiveDocument
   
    Set intSheetObj = intDocObj.Sheets.ActiveSheet
    Set intBckViewObj = intSheetObj.Views.Item(2)
   
   
'***Suche erstellen
    Dim intSelObj As Selection
    Dim intSearchStringStr As String
    Dim intMessageStr As String
    Dim i As Integer
    Dim intTextfieldArr() As DrawingText
    ReDim intTextfieldArr(0)
    Dim intArrayCounterInt As Integer
    Dim intMultiTextfieldMsgState As VbMsgBoxResult
   
    Set intSelObj = intDocObj.Selection
    intSelObj.Clear
    intArrayCounterInt = 1
   
    intSearchStringStr = "(Name=" & intTextBoxNameStr & " & " & "CATDrwSearch.DrwText),all"
    intSelObj.Search intSearchStringStr ' "(Name='TEST.1' & CATDrwSearch.DrwText),all"
    If intSelObj.Count = 0 Then
        intMessageStr = "NoFieldFound"
    ElseIf intSelObj.Count = 1 Then
        If intSelObj.Item(1).Value.Parent.Parent.Name = "Background View" Then
            intSelObj.Delete
            intSelObj.Clear
            intMessageStr = "TextfieldDeleted"
        Else
            intMessageStr = "NoFieldFound"
            intSelObj.Clear
        End If
    ElseIf intSelObj.Count > 1 Then
        For i = 1 To intSelObj.Count
       
            If intSelObj.Item(i).Value.Parent.Parent.Name = "Background View" Then
                ReDim Preserve intTextfieldArr(intArrayCounterInt)
                Set intTextfieldArr(intArrayCounterInt) = intSelObj.Item(i).Value
                intArrayCounterInt = intArrayCounterInt + 1
            End If
        Next
        If UBound(intTextfieldArr) = 0 Then
            intMessageStr = "NoFieldFound"
            intSelObj.Clear
        ElseIf UBound(intTextfieldArr) = 1 Then
            intSelObj.Clear
            intSelObj.Add intTextfieldArr(1)
            intSelObj.Delete
            intMessageStr = "TextfieldDeleted"
        ElseIf UBound(intTextfieldArr) > 1 Then
            'intMultiTextfieldMsgState = MsgBox("Es wurden mehrer Textfelder mit dem eingegebenen Namen im Blatthintergrund gefunden!" + Chr(10) + _
            '                                    "Wollen Sie alle Textfelder löschen?", vbQuestion + vbYesNo, "Mehrere Textfelder gefunden")
            'If intMultiTextfieldMsgState = vbNo Then
            '    intMessageStr = "NoDeleting"
            'Else
                intSelObj.Clear
                For i = 1 To UBound(intTextfieldArr)
                    On Error Resume Next
                    intSelObj.Add intTextfieldArr(i)
                    On Error GoTo 0
                Next
                intSelObj.Delete
                intSelObj.Clear
                intMessageStr = "MultiTextfieldDeleted"
            'End If
        End If
    End If
   
    End Function

---

Hat einer von euch da vieleicht eine Idee zu, wie man den Code so anpasst ?

------------------
MfG

N4426

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

---

Servus
Ich sehe da zwei Lösungsmöglichkeiten:
- Background selektieren, und mit der Suche nur im Hintergrund suchen/selektieren lassen.
- eine Schleife über alle Texte im Background laufen lassen,  falls der Name des Textes dem Suchkriterium entspricht der Selektion hinzuzufügen, selektierte Elemente löschen.

EDIT: Beispiel zur 1, Lösung ungetestet):

Code:

---

Public Function DeletTxtFeld(varTextfeldName As String)

    Dim intDocObj As Document
    Dim intObjTypeStr As String   
 
    '***Background View zugänglich machen
    Dim intSheetObj As DrawingSheet
    Dim intBckViewObj As DrawingView
 
    Set intDocObj = CATIA.ActiveDocument
 
    Set intSheetObj = intDocObj.Sheets.ActiveSheet
    Set intBckViewObj = intSheetObj.Views.Item(2)
 
 
    '***Background selektieren
    Dim intSelObj As Selection
    Set intSelObj = intDocObj.Selection

    intSelObj.add intBckViewObj

    '***Suche erstellen
    Dim intSearchStringStr As String
 
    intSearchStringStr = "(Name=" & varTextfeldName & " & " & "CATDrwSearch.DrwText),sel"
    intSelObj.Search intSearchStringStr
 
    intSelObj.Delete
    intSelObj.Clear
 
    End Function

---

Gruß
Bernd

------------------
Warum einfach, wenn es auch kompliziert geht.

[Diese Nachricht wurde von bgrittmann am 15. Nov. 2011 editiert.]

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

---

Hi Bernd,

ich habs gestern dann noch so gelöst.

Code:

---

Public Function DeletTxtFeld(varTextfeldName As String, varSheetName As String)
    Dim intDocObj As Document
    Dim intWindowsObj As Windows
    Dim intObjTypeStr As String
    Dim intTextBoxNameStr As String
   
    intTextBoxNameStr = varTextfeldName
   
   
    '***Background View zugänglich machen
    Dim intSheetObj As DrawingSheet
    Dim intBckViewObj As DrawingView
   
    Set intDocObj = CATIA.ActiveDocument
   
    Set intSheetObj = intDocObj.Sheets.ActiveSheet
    Set intBckViewObj = intSheetObj.Views.Item(2)
   
   
'***Suche erstellen
    Dim intSelObj As Selection
    Dim intSearchStringStr As String
    Dim intMessageStr As String
    Dim i As Integer
    Dim intTextfieldArr() As DrawingText
    ReDim intTextfieldArr(0)
    Dim intArrayCounterInt As Integer
    Dim intMultiTextfieldMsgState As VbMsgBoxResult
   
    Set intSelObj = intDocObj.Selection
    intSelObj.Clear
    intArrayCounterInt = 1
   
    intSearchStringStr = "(Name=" & intTextBoxNameStr & " & " & "CATDrwSearch.DrwText),all"
    intSelObj.Search intSearchStringStr ' "(Name='TEST.1' & CATDrwSearch.DrwText),all"
    If intSelObj.Count = 0 Then
        intMessageStr = "NoFieldFound"
    ElseIf intSelObj.Count = 1 Then
    MsgBox "eins"
   

        If intSelObj.Item(1).Value.Parent.Parent.Name = "Background View" And intSelObj.Item(1).Value.Parent.Parent.Parent.Parent.Name = varSheetName Then
            'intSelObj.Delete
            intSelObj.Clear
            intMessageStr = "TextfieldDeleted"
        Else
            intMessageStr = "NoFieldFound"
            intSelObj.Clear
        End If
    ElseIf intSelObj.Count > 1 Then
        For i = 1 To intSelObj.Count

            If intSelObj.Item(i).Value.Parent.Parent.Name = "Background View" And intSelObj.Item(i).Value.Parent.Parent.Parent.Parent.Name = varSheetName Then
                ReDim Preserve intTextfieldArr(intArrayCounterInt)
                Set intTextfieldArr(intArrayCounterInt) = intSelObj.Item(i).Value
                intArrayCounterInt = intArrayCounterInt + 1
            End If
        Next
        If UBound(intTextfieldArr) = 0 Then
            intMessageStr = "NoFieldFound"
            intSelObj.Clear
        ElseIf UBound(intTextfieldArr) = 1 Then
            intSelObj.Clear
            intSelObj.Add intTextfieldArr(1)
            intSelObj.Delete
            intMessageStr = "TextfieldDeleted"
        ElseIf UBound(intTextfieldArr) > 1 Then
            'intMultiTextfieldMsgState = MsgBox("Es wurden mehrer Textfelder mit dem eingegebenen Namen im Blatthintergrund gefunden!" + Chr(10) + _
            '                                    "Wollen Sie alle Textfelder löschen?", vbQuestion + vbYesNo, "Mehrere Textfelder gefunden")
            'If intMultiTextfieldMsgState = vbNo Then
            '    intMessageStr = "NoDeleting"
            'Else
                intSelObj.Clear
                For i = 1 To UBound(intTextfieldArr)
                    On Error Resume Next
                    intSelObj.Add intTextfieldArr(i)
                    On Error GoTo 0
                Next
                intSelObj.Delete
                intSelObj.Clear
                intMessageStr = "MultiTextfieldDeleted"
            'End If
        End If
    End If
   
    End Function

---

Trozdem Danke für deine Hilfe.

------------------
MfG

N4426

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