Tipp 0288 Wörter suchen und zählen
Autor/Einsender:
Datum:
  Angie
19.11.2002
Entwicklungsumgebung:   Word 97
Mit folgender Prozedur lässt sich nicht nur ermitteln, wie oft ein bestimmtes Wort oder auch Wortfolge im Hauptteil eines Dokuments vorkommt, sondern auch wie oft das Wort/die Wortfolge auf der jeweiligen Seite vorhanden ist.
 
Option Explicit

Private Const mc_MsgTitle As String = "VB-fun-Demo"

Sub WortSuchenUndSeitenzahlAusgeben()
  Dim objWDDoc      As Word.Document
  Dim intPagesCnt   As Integer

  Dim strFind       As String
  Dim intCntSum     As Integer
  Dim intCnt        As Integer

  Dim intPageNum    As Integer
  Dim aintFound()   As Integer

  Dim i             As Integer
  Dim strMsg        As String

  strFind = InputBox("Bitte geben Sie den Suchbegriff ein:", _
            Title:=mc_MsgTitle, Default:="Hallihallo...")

  If StrPtr(strFind) <> 0 Then
    If Len(strFind) > 0 Then
      Application.ScreenUpdating = False

      Set objWDDoc = ActiveDocument
      objWDDoc.Range(0, 0).Select
      objWDDoc.Repaginate

      intPagesCnt = objWDDoc.ComputeStatistics(wdStatisticPages)
      ReDim aintFound(1 To intPagesCnt)

      intCntSum = 0
      intCnt = 0
      intPageNum = 0

      With Selection.Find
        .ClearFormatting
        .Forward = True
        .MatchWholeWord = True
        .MatchCase = False
        .Wrap = wdFindContinue

        .Text = strFind
        .Execute

        While .Found = True
          intCntSum = intCntSum + 1
          If intPageNum = Selection.Information( _
                       wdActiveEndPageNumber) Then
            intCnt = intCnt + 1
          Else
            intCnt = 1
            intPageNum = Selection.Information( _
                           wdActiveEndPageNumber)
          End If
          aintFound(intPageNum) = intCnt
          .Execute
        Wend
      End With

      If intCntSum > 0 Then
        strMsg = "Der Suchbegriff '" & strFind & _
              "' kommt insgesamt " & CStr(intCntSum) & _
              " mal im Hauptteil des Dokumentes vor!" & _
              vbCrLf & vbCrLf

        For i = 1 To UBound(aintFound)
          If aintFound(i) > 0 Then
            strMsg = strMsg & CStr(aintFound(i)) & _
                  " mal auf Seite " & i & vbCrLf
          End If
        Next i

        strMsg = Mid(strMsg, 1, Len(strMsg) - 2)
        MsgBox strMsg, vbOKOnly + vbInformation, mc_MsgTitle

      Else
        MsgBox "Das Wort '" & strFind & "' kommt " & _
               "im Hauptteil des Dokumentes nicht vor!", _
               vbOKOnly + vbInformation, mc_MsgTitle
      End If

      objWDDoc.Range(0, 0).Select
      Application.ScreenUpdating = True

      Set objWDDoc = Nothing
    End If
  End If
End Sub
 
Hinweis
Die im Download befindliche *.bas-Datei kann in Word im VB-Editor importiert werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Word-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (2,3 kB) Downloads bisher: [ 930 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 30. Mai 2011