Anzeige

 Durchlaufen eines Textfeldes


#1
Hallo,

ich versuche einen Code für ein Makro zu erstellen, der alle Textfelder (Textboxen) eines Word-Dokuments durchläuft und alle Kleinbuchstaben geben ein "x" und alle Großbuchstaben gegen ein "X" austauscht. Die Formatierung, sowie Satzzeichen etc. sollen dabei erhalten bleiben. Ich habe nun bereits folgenden Code:

Code:
Sub textfelder()
    Dim shp As Shape
    Dim wort As String
    Dim iAnswer As Integer
    Dim i, l, m, count, zeichenzahl As Long
    Dim satz, worte As Range

    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            shp.Select
            Selection.ShapeRange.TextFrame.TextRange.Select
            count = Selection.Characters.count
            For i = 1 To count Step 1
                If Selection.Characters(i) Like "*[A-Z,Ä,Ö,Ü,0-9,a-z,ß,ä,ö,ü]*" Then
                    Select Case Selection.Characters(i)
                        Case " "
                            Selection.Characters(i) = " "
                        Case Else
                            If isUpperCase(Selection.Characters(i)) Then
                                Selection.Characters(i) = "X"
                            Else
                                Selection.Characters(i) = "x"
                            End If
                    End Select
                End If
            Next
        End If
    Next
End Sub
Jedoch wird dabei jeweils nur das erste Zeichen umgewandelt und ich erhalte die Fehlermeldung, dass das ausgewählte Element nicht in der Sammlung erhalten sei. (An der Stelle If Selection.Characters(i) Like "*[A-Z,Ä,Ö,Ü,0-9,a-z,ß,ä,ö,ü]*" Then)

Beim zweiten Versuch:

Code:
Sub textfelder()              
    Dim shp As Shape
    Dim wort As String
    Dim iAnswer As Integer
    Dim i, l, m, count, Zeichenzahl As Long
    Dim satz, worte As Range

    i = 0
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            shp.Select
            Selection.ShapeRange.TextFrame.TextRange.Select
            Do
                l = 0
                i = i + 1
                count = Selection.Sentences(i).Words.count
                Set satz = Selection.Sentences(i)
                Do
                    l = l + 1
                    Set worte = satz.Words(l)
                    If worte Like "*[A-Z,Ä,Ö,Ü,a-z,ä,ö,ü,ß,0-9]*" Then
                        Zeichenzahl = worte.End - worte.Start
                        For m = 1 To Zeichenzahl
                            Select Case Selection.Sentences(i).Characters(m)
                                Case " "
                                    Selection.Sentences(i).Characters(m) = " "
                                Case Else
                                    If isUpperCase(Selection.Sentences(i).Characters(m)) Then
                                         Selection.Sentences(i).Characters(m) = "X"
                                    Else
                                        Selection.Sentences(i).Characters(m) = "x"
                                    End If
                            End Select
                        Next
                    End If
                Loop Until l = count
            Loop Until Selection.Sentences(i).End = Selection.End
        End If
    Next
End Sub
wird das erste Wort umgewandelt, jedoch bekomme ich dann den selben Fehler. In diesem Fall an der Stelle count = Selection.Sentences(i).Words.count.

Kann mir jemand weiter helfen wieso ich stets diese Fehlermeldung bekomme?
Den Code habe ich bereits so ähnlich für den allgemeinen Text benutzt, dabei hat alles soweit funktioniert.
 

Yaslaw

n/a
Moderator
#2
Ich habe jetzt noch nicht alles angeschaut, da ich VBA in Word gar nicht kenne. aber:

XY.select
selection.irgendwas

Warum? Du kanst direkt zugreifen
xy.irgendwas

2 Verschachtelte Do, die denselben Zähler hochzählen. Macht das Sinn?

Warum greifst du über auf Selection.Sentences(i) zu, wo du das doch bereits als satz hast?

Das LIKE [viele Argumente] kenne ich nur von Regulären Ausdrücken. Geht das so in Word?

Hast du schon mal an einen Regulären Ausdruck gedacht? Der ersetzt in Sätzen alle Buchstaben wie gewünscht
Visual Basic:
Dim rx As Object
Set rx = CreateObject("VBScript.RegExp")

rx.global = true
rx.pattern = "[A-ZÄÖÜ]"
meinText = rx.replace(meinText, "X")
rx.pattern = "[a-zäöü]"
meinText = rx.replace(meinText, "x")
 
#3
Hallo,
danke für die Antwort. Ich arbeite erst seit zwei Tagen mit VBA und kenne mich deshalb da noch nicht so gut aus.
Wie greife ich denn direkt auf ein Textfeld zu, dessen Namen ich nicht kenne? (Soll ja auf beliebige Dokumente anwendbar sein) Habe dazu nichts entsprechendes im Netz gefunden, dass in Word funktioniert hätte.
Das Like scheint in Word so zu funktionieren, das habe ich bereits in einem anderen Code verwendet.
Ich werde es auf jeden Fall gleich mal mit deinem Vorschlag versuchen, vielen Dank!
 
#4
Ich habe es eben (erstmal nur mit dem Vorschlag des regulären Ausdrucks) versucht, denke jedoch ich habe etwas falsch umgesetzt, da mir angezeigt wird, dass das Object Satz die Methoden Global und Pattern nicht unterstützt. Zudem musste ich das CreateObject bei set satz entfernen, da eine Objecterstellung durch ActiveX-Komponenten nicht möglich ist (?).
Was habe ich falsch gemacht?

Code:
Sub textfelder2()
Dim shp As Shape
Dim satz, meinText As Object
Dim count, i As Long

For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            shp.Select
            Selection.ShapeRange.TextFrame.TextRange.Select
            count = Selection.Sentences.count
            For i = 1 To count
                Set satz = Selection.Sentences(i)
                satz.Global = True
                satz.Pattern = "[A-ZÄÖÜ]"
                meinText = satz.Replace(meinText, "X")
                satz.Pattern = "[a-zäöüß]"
                meinText = satz.Replace(meinText, "x")
            Next
        End If
    Next
End Sub
 

Yaslaw

n/a
Moderator
#5
Dir fehlt das Initialisieren des Objektes
Visual Basic:
Set rx = CreateObject("VBScript.RegExp")
satz ist bei dir kein RegExp-Objekt
Also umgesetzt müsste es irgendiwe so aussehen
Visual Basic:
Dim rx as Object
Set rx = CreateObject("VBScript.RegExp")
rx.Global = True

For Each shp In ActiveDocument.Shapes
    ..
           For i = 1 To count
                Set satz = Selection.Sentences(i)
                '// TODO: Irgendwie meinText aus dem Objekt satz extrahieren. Also irgend sowas:
                meinText = satz.value

                rx.Pattern = "[A-ZÄÖÜ]"
                meinText = rx.Replace(meinText, "X")
                rx.Pattern = "[a-zäöüß]"
                meinText = rx.Replace(meinText, "x")
            Next
    ...
Loop
 
#6
Noch einmal vielen vielen Dank! :)
Ich habe es jetzt so:

Code:
Sub textfelder2()
Dim shp As Shape
Dim rx As Object
Dim count, i As Long
Dim meinText As String
Dim satz As Range

Set rx = CreateObject("VBScript.RegExp")
rx.Global = True
For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            shp.Select
            Selection.ShapeRange.TextFrame.TextRange.Select
            count = Selection.Sentences.count
            For i = 1 To count
                Set satz = Selection.Sentences(i)
                meinText = satz.text
                rx.Pattern = "[A-ZÄÖÜ]"
                meinText = rx.Replace(meinText, "X")
                rx.Pattern = "[a-zäöüß]"
                meinText = rx.Replace(meinText, "x")
                satz = meinText
            Next
        End If
    Next
End Sub
Jetzt funktioniert es wieder mit dem ersten Satz, danach kommt erneut die Fehlermeldung, dass das Objekt nicht in der Sammlung enthalten wäre und die Stelle Set satz = Selection.Sentences(i) wird als Problem markiert.
Wenn ich das Objekt Selection.Sentences(2) per Hand aufrufe oder die Schleife mit i = 2 beginnen lasse, ist das Objekt auffindbar, jedoch dann entsprechend der 3. Satz nicht mehr.
 
Zuletzt bearbeitet:

Yaslaw

n/a
Moderator
#7
Sorry, da muss ich passen. Ich kenne die Word-Objekt-Struktur absolut nicht.
Schau mit mit der F1-Hilfe nach, wie die Struktur aufgebaut ist. Ev. hilft das weiter.

satzs cheint ein Objekt zu sein. Dann kannst du nicht einfach den Text dem Objekt zuweisen.
Visual Basic:
'sollte mMn einen Fehlergeben
satz = meinText
'Das wäre dielogische Umsetzung
satz.text = meinText
Des weiteren. Arbeite nicht mit Selektionieren. Das ist nicht gut.
Selektioniere den shape. Selektioniere den TextRange im selektionierten Shape. Iteriere über die Sentences der Selektion

Hast du schon mal versucht, über die Sentinences mit der For Each Schleife zu iterieren?
Ich würde es etwa so probieren
Visual Basic:
Sub textfelder2()
    Dim shp As Shape
    Dim rx As Object
    Dim count, i As Long
    Dim meinText As String
    Dim rng As Range        'Oder Objekt oder Variant
     
    Set rx = CreateObject("VBScript.RegExp")
    rx.Global = True
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            For each rng In shp.ShapeRange.TextFrame.TextRange.Sentences
                meinText = rng.text
                rx.Pattern = "[A-ZÄÖÜ]"
                meinText = rx.Replace(meinText, "X")
                rx.Pattern = "[a-zäöüß]"
                meinText = rx.Replace(meinText, "x")
                rng.text = meinText
            Next
        End If
    Next
End Sub
Falls es viele Textboxen sind, dann dürfte es performanter sein, 2 RegExp-Objekte zu erstellen
Visual Basic:
Sub textfelder2()
    Dim shp As Shape
    Dim rxU As Object
    Dim rxL As Object
    Dim count, i As Long
    Dim meinText As String
    Dim rng As Range        'Oder Objekt oder Variant
     
    'Upper Case RegExp
    Set rxU = CreateObject("VBScript.RegExp")
    rxU.Global = True
    rxU.Pattern = "[A-ZÄÖÜ]"

    'Lower Case RegExp
    Set rxL = CreateObject("VBScript.RegExp")
    rxL.Global = True
    rxL.Pattern = "[a-zäöüß]"

    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoTextBox Then
            For each rng In shp.ShapeRange.TextFrame.TextRange.Sentences
                meinText = rng.text
                meinText = rxU.Replace(meinText, "X")
                meinText = rxL.Replace(meinText, "x")
                rng.text = meinText
            Next
        End If
    Next
End Sub
 
Anzeige

Neue Beiträge

Anzeige