Shape nach Text durchsuchen und Textmarke setzten

  • Word

Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von Petersilie.

    Shape nach Text durchsuchen und Textmarke setzten

    Hallo Leute,

    ich möchte Word Dokumente nach bestimmtem Text durchsuchen und dann eine Textmarke dort ablegen.

    Ich durchsuche die Normale TextRange einfach mit:

    Visual Basic-Quellcode

    1. For i = 0 To 16
    2. Set rng = ActiveDocument.Content
    3. With rng.Find
    4. .Text = arrTxt(i)
    5. .Forward = True
    6. .Wrap = wdFindStop
    7. .Execute
    8. bfound = .Found
    9. End With
    10. If bfound Then
    11. rng.Bookmarks.Add (arrMarke(i))
    12. End If
    13. Next i


    Nun ist das Problem, dass es eine TextBox gibt bzw ein TextFrame am Anfang des Dokumentes, in diesem möchte ich auch suchen.
    Das mache ich mit:

    Visual Basic-Quellcode

    1. For Each obj In ThisDocument.Shapes
    2. If obj.Name = "Text Box 2" Then
    3. obj.Select
    4. For i = 0 To 16
    5. With Selection.Find
    6. .Text = arrTxt(i)
    7. .Forward = True
    8. .Wrap = wdFindStop
    9. .Execute
    10. bfound = .Found
    11. End With
    12. If bfound Then
    13. Selection.Bookmarks.Add (arrMarke(i))
    14. End If
    15. Next i
    16. End If
    17. Next obj



    Das Problem ist, dass er nur einen einzigen gesuchten Text in der Box findet... der Rest steht zwar auch drinnen aber er findet ihn nicht.
    Wisst ihr woran das liegt?
    Hallo,

    ist das sicher, dass er die nicht findet? Evtl. findet er immer das gleiche, da der gesamte Inhalt der TextBox als Treffer gewertet wird. Zumindest geht Word 2016 bei Textfeldern so vor.

    Lass Dir mit debug.print mal die Treffer mit angeben oder zähle diese mit.
    Gruß
    Peterfido

    Keine Unterstützung per PN!
    @peterfido Hallo, danke für deine Antwort.
    Habe das ganze mit dem debugger und .print durchgespielt, gefunden hat er sie wirklich, aber dann eben nicht
    abgeändert.
    Das lag daran, dass ich außerhalb der schleife das Objekt ausgewählt habe.
    Mit folgendem Code macht er es:

    Visual Basic-Quellcode

    1. For Each obj In ThisDocument.Shapes
    2. If obj.Name = "Text Box 2" Then
    3. For i = 0 To (arrTxt.Count - 1)
    4. obj.Select
    5. With Selection.Find
    6. .Text = arrTxt(i)
    7. .Forward = True
    8. .Wrap = wdFindStop
    9. .Execute
    10. bfound = .Found
    11. End With
    12. If bfound Then
    13. Selection.Bookmarks.Add (arrMarke(i))
    14. j = j + 1
    15. ReDim Preserve removeFromIndex(j)
    16. removeFromIndex(j) = arrMarke(i)
    17. End If
    18. Next i
    19. End If
    20. Next obj


    Ich habe nun die Arrays verworfen und durch ArrayLists ersetzt, da er sonst wenn er das Dokument und nicht die Box durchsucht,
    den gesuchten Text evtl wieder findet und die Textmarke neu an falscher stelle setzt.
    Ein Löschen und neu Dimensionieren sowie initialisieren der Arrays war mir zu aufwendig, das geht mit den ArrayLists wesentlich einfacher und schneller.

    Das Array "removeFromIndex" speichert den eingesetzten Eintrag, nach der Schleife Lösche ich dann alle dort gespeicherten Einträge aus den
    ArrayLists raus und habe somit nur noch die Daten die mir Fehlen.
    Vielleicht keine Optimale Lösung oder besonders gut und sauber geschrieben, aber es funktioniert.
    Hier Code mit kommentaren, lasst es mich wissen wenn ihr eine bessere oder schönere Lösung findet:

    Visual Basic-Quellcode

    1. Sub txtmarke()
    2. Dim rng As Range 'unsere Dokumenten Range später
    3. Dim bfound As Boolean 'true wenn Text gefunden wurde
    4. Dim i As Integer, j As Integer 'Zaehler
    5. Dim removeFromIndex() 'Speichert gefundene Daten
    6. Dim removeFromIndex_2() 'Same here
    7. Dim temp 'Same here
    8. 'ThisDocument.VBProject.References.AddFromFile "C:\WINDOWS\Microsoft.NET\Framework\v4.0.30319\mscorlib.dll"
    9. CreateObject ("System.Collections.ArrayList") 'Sonst können wir keine ArrayList nutzen
    10. Dim arrTxt As New ArrayList
    11. arrTxt.Add "Text der gefunden werden soll"
    12. Dim arrMarke As New ArrayList
    13. arrMarke.Add "Name der Bookmark"
    14. j = -1 'nicht null da j später um eins erhöht wird
    15. 'und wir sonst die erste Dimension auslassen würden
    16. temp = "" 'gleicht später ab ob Wert bereits in Box gefunden wurde
    17. For Each obj In ThisDocument.Shapes
    18. If obj.Name = "Text Box 2" Then
    19. For i = 0 To (arrTxt.Count - 1)
    20. obj.Select
    21. 'In meiner ArrayList gibt es manche Daten
    22. 'doppelt, jedoch kommen Sie nur einmal im Objekt vor
    23. 'deshalb gleichen wir ab ob der gesuchte Text schonmal
    24. 'gefunden wurde
    25. If arrTxt(i) <> temp Then
    26. With Selection.Find
    27. .Text = arrTxt(i)
    28. .Forward = True
    29. .Wrap = wdFindStop
    30. .Execute
    31. bfound = .Found
    32. End With
    33. If bfound Then
    34. temp = arrTxt(i) 'verhindern das eine Marke
    35. 'mehrmals in der Box gesetzt wird
    36. Selection.Bookmarks.Add (arrMarke(i)) 'Marke setzten
    37. j = j + 1 'Array Dimension erhöhen
    38. ReDim Preserve removeFromIndex(j) 'Array vergrößern und Werte behalten
    39. ReDim Preserve removeFromIndex_2(j) 'Same here
    40. removeFromIndex(j) = arrMarke(i) 'wir speichern den Wert
    41. removeFromIndex_2(j) = arrTxt(i) 'Same here
    42. End If
    43. End If
    44. Next i
    45. End If
    46. Next obj
    47. 'Da verhindert werden soll, dass eine Marke
    48. 'übschrieben wird, löschen wir hier alle bereits
    49. 'gesetzten Marken aus der ArrayList heraus
    50. i = 0
    51. Do
    52. arrMarke.Remove removeFromIndex(i)
    53. arrTxt.Remove removeFromIndex_2(i)
    54. i = i + 1
    55. Loop Until i > UBound(removeFromIndex)
    56. Erase removeFromIndex 'Wir löschen das Array da es nicht mehr gebraucht wird
    57. Erase removeFromIndex_2 'Same here
    58. 'Nun Suchen wir im Dokument nach dem gesuchten Text
    59. 'ACHTUNG! Header und Footer werden hier nicht durchsucht
    60. For i = 0 To (arrTxt.Count - 1)
    61. Set rng = ActiveDocument.Content
    62. With rng.Find
    63. .Text = arrTxt(i)
    64. .Forward = True
    65. .Wrap = wdFindStop
    66. .Execute
    67. bfound = .Found
    68. End With
    69. If bfound Then
    70. rng.Bookmarks.Add (arrMarke(i))
    71. End If
    72. Next i
    73. End Sub