Sub ZaehleWorte 'Werner Roth 'Dieses Makro zählt wie viele Worte aktuell selektiert sind. 'Dazu wird der selektierte Text durchlaufen und alle Trennzeichen gezählt 'Texte in Rahmen müssen einzeln selektiert werden. Ansonsten werden sie nicht mitgezählt. const MsgBoxErrorTitle = "Fehler Werners WordCount" dim NumFound as long dim SelectedText as string dim LastWasSeperator as boolean 'Erst einmal eine Menge Fehlerbehandlung: 'Das Ding ist nur für StarWriter gedacht if ActiveModule.Name <> "StarWriter" then MsgBox("Werners WordCount ist nur innerhalb eines Textdokumenten anwendbar.",_ 16,MsgBoxErrorTitle) EXIT SUB Endif If (ActiveWindow.Selection.ClassName <> "Text") and _ (ActiveWindow.Selection.ClassName <> "TextInTable") then MsgBox("Es muss zumindest Text oder eine Tabelle selektiert sein.",_ 16,MsgBoxErrorTitle) EXIT SUB Endif 'Speichere den selektierten Text in einem String SelectedText = ActiveWindow.ValueAndBreaks 'Strings schaffen nun mal nur 64.000 Zeichen if SelectedText = "" then MsgBox("Entweder nichts selektiert oder mehr als 64.000 Zeichen selektiert.",_ 16,MsgBoxErrorTitle) EXIT SUB Endif Application.EnterWait() 'Sanduhr zeigen 'Anzahl der gefundenen Worte NumFound = 0 'Zwei und mehr aufeinanderfolgende Trennzeichen werden als eins gezählt LastWasSeperator = false 'Laufe den selektierten Text Buchstabe für Buchstabe durch for i=1 to len(SelectedText) Select Case Mid(SelectedText,i,1) 'Hier kann man noch Trennzeichen ergänzen 'chr(9) ist ein Tabulator chr(10) und chr(13) sind für Zeilen- und Absatzenden Case " ", ",", ";", ".", "-", chr(9), chr(10), chr(13) 'Die Wortanzahl nur dann hochzählen, wenn der Buchstabe zuvor kein Trennzeichen war if not LastWasSeperator then NumFound = NumFound + 1 LastWasSeperator = true Endif 'Buchsteben gefunden, also kein Trennzeichen Case Else LastWasSeperator = false End Select next i Application.LeaveWait() 'Sanduhr wieder wech MsgBox( "Die Anzahl selektierter Worte ist: " & NumFound,_ 0+64, "Werners WordCount") End Sub