Sub SignsByWords()
Dim Sign As String
Dim Max As Integer, Total As Integer, Sings As Integer
Dim Counter As Long, Progress As Long, totalWords As Long
Dim Sel As range
Dim iPrecatege As Integer
totalWords = ActiveDocument.ComputeStatistics(wdStatisticWords)
Start:
a = InputBox("במסמך יש: " & totalWords & "מילים " & vbCrLf & _
"כל כמה מילים להכניס סימון" & vbCrLf & vbCrLf & _
"החלוקה היא לפי משפטים" & vbCrLf & "דהיינו נקודה או סוף פסקה", _
"הכנס סימון לפי מילים", "1000")
If StrPtr(a) = 0 Then Exit Sub
'Check if input is a number
If Not IsNumeric(a) Then
'a is not a number
MsgBox "הכנס מספר חיובי הגדול מ-100", vbMsgBoxRtlReading, "הכנס סימון לפי מילים"
GoTo Start
Else
'a is a number and can be converted to Integer
Max = CInt(a)
End If
If Max < 100 Then
MsgBox "הכנס מספר חיובי הגדול מ-100", vbMsgBoxRtlReading, "הכנס סימון לפי מילים"
GoTo Start
ElseIf Max >= totalWords Then
MsgBox "המספר גדול מסך המילים בקובץ.", vbMsgBoxRtlReading, "הכנס סימון לפי מילים"
GoTo Start
End If
Sign = InputBox("איזה סימן להכניס בטקסט", "הכנס סימון לפי מילים", "$")
If Sign = "" Then Sign = "$"
'Gets the total Sentences count
Total = ActiveDocument.Sentences.Count
Application.ScreenUpdating = False
'Loops through all Sentences
For Each Sel In ActiveDocument.Sentences
Progress = Progress + 1
'Adds real word count to Counter
Counter = Counter + Sel.ComputeStatistics(wdStatisticWords)
If Counter >= (Max * 0.99) Then
Sel.InsertAfter (Sign)
'Countings signs that was insereted
Sings = Sings + 1
'Elapses the counter
Counter = 0
End If
iPrecatege = (Progress * 100 / Total)
StatusBar = "Processing " & iPrecatege & " % "
Next Sel
Application.ScreenUpdating = True
MsgBox "סיים! הוכנסו סך הכל: " & Sings & "סימונים.", vbMsgBoxRtlReading, "הכנס סימון לפי מילים"
End Sub
הנושאים החמים
הנושאים החמים
