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