Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 14.03.2017, 11:40   #1
Vasily.T
Новичок
Джуниор
 
Регистрация: 04.02.2017
Сообщений: 2
Вопрос Подсчет количества слов и символов

Добрый день, знатоки!
Прошу подсказать как разобраться с работой встроенных функций в vba.
Для изучения vba написал по примерам из интернета небольшую программу для подсчета числа символов и слов в word'е. Программа считает количество слов и символов так-же, как кнопка статистики. Встроенные функции Selection.Words.Count и Selection.Charcters.Count дают отличный от статистики ворда результат. Прикладываю код и скрины сообщений. Подскажите, что делаю не правильно.

Код:
' Ïîäñ÷åò ÷èñëà ñèìâîëîâ, ñëîâ è ñòðîê â äîêóìåíòå
Public Sub main()
   FormatText
   PrintStatistics CharCalc, WordsCalc, LinesCalc
End Sub
' Ôîðìàòèðîâàíèå òåêñòà
Private Sub FormatText()
   
   Selection.HomeKey Unit:=wdStory
   
   Selection.WholeStory
   Selection.Font.Name = "Times New Roman"
   Selection.Font.Size = 12
   With Selection.ParagraphFormat
      .LeftIndent = CentimetersToPoints(0)
      .RightIndent = CentimetersToPoints(0)
      .SpaceBefore = 0
      .SpaceBeforeAuto = False
      .SpaceAfter = 0
      .SpaceAfterAuto = False
      .LineSpacingRule = wdLineSpaceSingle
      .Alignment = wdAlignParagraphJustify
      .WidowControl = True
      .KeepWithNext = False
      .KeepTogether = False
      .PageBreakBefore = False
      .NoLineNumber = False
      .Hyphenation = True
      .FirstLineIndent = CentimetersToPoints(1.25)
      .OutlineLevel = wdOutlineLevelBodyText
      .CharacterUnitLeftIndent = 0
      .CharacterUnitRightIndent = 0
      .CharacterUnitFirstLineIndent = 0
      .LineUnitBefore = 0
      .LineUnitAfter = 0
      .MirrorIndents = False
      .TextboxTightWrap = wdTightNone
      .AutoAdjustRightIndent = True
      .DisableLineHeightGrid = False
      .FarEastLineBreakControl = True
      .WordWrap = True
      .HangingPunctuation = True
      .HalfWidthPunctuationOnTopOfLine = False
      .AddSpaceBetweenFarEastAndAlpha = True
      .AddSpaceBetweenFarEastAndDigit = True
      .BaseLineAlignment = wdBaselineAlignAuto
   End With
   With ActiveDocument
      .AutoHyphenation = True
      .HyphenateCaps = True
      .HyphenationZone = CentimetersToPoints(0.63)
      .ConsecutiveHyphensLimit = 0
   End With
End Sub
' Ïîäñ÷åò ÷èñëà âèäèìûõ ñèìâîëîâ
Private Function CharCalc() As Integer
   Dim strTemp          As String
   Dim varA             As Variant
   Dim intRus           As Integer
   Dim intEng           As Integer
   Dim intDig           As Integer
   Dim intPunct         As Integer
   Dim intTextLength    As Integer
   strTemp = ""
   varA = Null
   intRus = 0
   intEng = 0
   intDig = 0
   intPunct = 0
       
   intTextLength = TextLen(strTemp)

    Dim i As Integer
    For i = 1 To intTextLength
        varA = Mid(strTemp, i, 1)
        If (varA >= "à" And varA <= "ÿ") Or varA = "¸" Or (varA >= "À" And varA <= "ß") Or varA = "¨" Then
            intRus = intRus + 1
        Else
            If (varA >= "a" And varA <= "z") Or (varA >= "A" And varA <= "Z") Then
                intEng = intEng + 1
            End If
            If (varA >= "0" And varA <= "9") Then
                intDig = intDig + 1
            End If
            If (varA = "," Or varA = "." Or varA = "!" Or varA = ";" _
               Or varA = "-" Or varA = ":") Then
               intPunct = intPunct + 1
            End If
        End If
    Next i
   
   CharCalc = intRus + intEng + intDig + intPunct
End Function
' Ïîäñ÷åò ÷èñëà ñëîâ
Private Function WordsCalc() As Integer
   Dim aVar             As Variant
   Dim intWords         As Integer
   Dim intTextLength    As Integer
   Dim strTemp          As String
   Dim strTempWord      As String
   
   aVar = Null
   intWords = 0
   intTextLength = 0
   strTemp = ""
   strTempWord = ""
   
   intTextLength = TextLen(strTemp)
   
   Dim i As Integer
   For i = 1 To intTextLength
      varA = Mid(strTemp, i, 1)
      If (varA <> " " And varA <> vbCr) Then
         strTempWord = strTempWord & varA
      Else
         If (Len(strTempWord) >= 1 And (varA = " " Or varA = vbCr)) Then
            intWords = intWords + 1
            strTempWord = ""
         End If
      End If
   Next i

WordsCalc = intWords
End Function
' Ïîäñ÷åò ÷èñëà ñòðîê
Private Function LinesCalc() As Integer

   Dim aVar             As Variant
   Dim intLines         As Integer
   Dim intTextLength    As Integer
   Dim strTemp          As String
   Dim strTempWord      As String
   
   aVar = Null
   intLines = 0
   intTextLength = 0
   strTemp = ""
   strTempWord = ""
   
   intTextLength = TextLen(strTemp)
 
LinesCalc = intLines
End Function
' Âûâîä ñòàòèñòèêè
Private Sub PrintStatistics(intChars As Integer, intWords As Integer, intLines As Integer)
'    Selection.EndKey
'    Selection.TypeParagraph
'    Selection.TypeParagraph
'    Selection.TypeParagraph
'    Selection.TypeText Text:="Êîëè÷åñòâî ñèìâîëîâ â òåêñòå: " & intChars
'    Selection.EndKey Unit:=wdLine
'    Selection.TypeParagraph
'    Selection.TypeText Text:="Âðåìÿ, çàòðà÷åííîå íà ÷òåíèå: "
'    Selection.TypeParagraph
'    Selection.TypeText Text:="Êîëè÷åñòâî ñëîâ: " & intWords
'    Selection.TypeParagraph
'    Selection.TypeText Text:="Êîëè÷åñòâî ñòðîê: " & intLines


'********* Âûâîä ñòàòèñòèêè ñâîèìè ôóíêöèÿìè, ðåçóëüòàò êàê â âîðäå ******
'MsgBox ("Êîëè÷åñòâî ñèìâîëîâ â òåêñòå: " & intChars & _
'       chr(13) & _
'       "Êîëè÷åñòâî ñëîâ: " & intWords & _
'       chr(13) & _
'       "Êîëè÷åñòâî ñòðîê: " & intLines)
'********* Âûâîä ñòàòèñòèêè ñâîèìè ôóíêöèÿìè, ðåçóëüòàò êàê â âîðäå ******
   


'********* Âûâîä ñòàòèñòèêè âñòðîåííûìè ôóíêöèÿìè, ðåçóëüòàò íå òàêîé êàê â âîðäå ******
   Dim strTemp As String
   Dim TextLen As Integer
   strTemp = ""


    Selection.HomeKey Unit:=wdStory                     'Óñòàíàâëèâàåò êóðñîð â íà÷àëî òåêñòà'
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend    'âûäåëÿåò âåñü òåêñò'
    strTemp = Selection.Text                             'Çàãðóæàåò âûäåëåííûé òåêñò â ïåðåìåííóþ'

MsgBox ("Êîëè÷åñòâî ñèìâîëîâ â òåêñòå: " & Selection.Characters.Count & _
       chr(13) & _
       "Êîëè÷åñòâî ñëîâ: " & Selection.words.Count & _
       chr(13) & _
       "Êîëè÷åñòâî ñòðîê: " & Selection.Sentences.Count)
'********* Âûâîä ñòàòèñòèêè âñòðîåííûìè ôóíêöèÿìè, ðåçóëüòàò íå òàêîé êàê â âîðäå ******
End Sub
' Äëèíà òåêñòà
Private Function TextLen(strTemp As String)
    Selection.HomeKey Unit:=wdStory                     'Óñòàíàâëèâàåò êóðñîð â íà÷àëî òåêñòà'
    Selection.EndKey Unit:=wdStory, Extend:=wdExtend    'âûäåëÿåò âåñü òåêñò'
    strTemp = Selection.Text                             'Çàãðóæàåò âûäåëåííûé òåêñò â ïåðåìåííóþ'
    TextLen = Len(strTemp)                               'Äëèíà òåêñòà'
End Function
Изображения
Тип файла: png Stat.png (15.0 Кб, 9 просмотров)
Тип файла: png Stat2.png (13.2 Кб, 37 просмотров)
Тип файла: png Stat3.png (12.6 Кб, 11 просмотров)
Вложения
Тип файла: zip Подсчет.zip (35.5 Кб, 6 просмотров)
Vasily.T вне форума Ответить с цитированием
Старый 14.03.2017, 17:41   #2
Vasily.T
Новичок
Джуниор
 
Регистрация: 04.02.2017
Сообщений: 2
Сообщение

Спасибо всем за просмотры темы. Мне удалось найти методы для подсчета статистики. Результаты подсчета аналогичны тем, что показывает ворд.
Еще раз всем спасибо. Если кому-то будет полезным:

Код:
' Ïîäñ÷åò ÷èñëà ñèìâîëîâ, ñëîâ è ñòðîê â äîêóìåíòå
Public Sub main()
   FormatText
   
   Dim rngLines         As Object
   Dim rngChars         As Object
   Dim rngWords         As Object

   Dim intLines         As Integer
   Dim intChars         As Integer
   Dim intWords         As Integer

   Set rngLines = Selection.Range
   Set rngChars = Selection.Range
   Set rngWords = Selection.Range
   
   intLines = 0
   intWords = 0
   intChars = 0
    
   Selection.HomeKey Unit:=wdStory                     'Óñòàíàâëèâàåò êóðñîð â íà÷àëî òåêñòà'
   Selection.EndKey Unit:=wdStory, Extend:=wdExtend    'âûäåëÿåò âåñü òåêñò'
    
   intLines = rngLines.ComputeStatistics(Statistic:=wdStatisticLines)
   intChars = rngChars.ComputeStatistics(Statistic:=wdStatisticCharacters)
   intWords = rngWords.ComputeStatistics(Statistic:=wdStatisticWords)
   PrintStatistics intChars, intWords, intLines
End Sub
' Ôîðìàòèðîâàíèå òåêñòà
Private Sub FormatText()
   
   Selection.HomeKey Unit:=wdStory
   
   Selection.WholeStory
   Selection.Font.Name = "Times New Roman"
   Selection.Font.Size = 12
   With Selection.ParagraphFormat
      .LeftIndent = CentimetersToPoints(0)
      .RightIndent = CentimetersToPoints(0)
      .SpaceBefore = 0
      .SpaceBeforeAuto = False
      .SpaceAfter = 0
      .SpaceAfterAuto = False
      .LineSpacingRule = wdLineSpaceSingle
      .Alignment = wdAlignParagraphJustify
      .WidowControl = True
      .KeepWithNext = False
      .KeepTogether = False
      .PageBreakBefore = False
      .NoLineNumber = False
      .Hyphenation = True
      .FirstLineIndent = CentimetersToPoints(1.25)
      .OutlineLevel = wdOutlineLevelBodyText
      .CharacterUnitLeftIndent = 0
      .CharacterUnitRightIndent = 0
      .CharacterUnitFirstLineIndent = 0
      .LineUnitBefore = 0
      .LineUnitAfter = 0
      .MirrorIndents = False
      .TextboxTightWrap = wdTightNone
      .AutoAdjustRightIndent = True
      .DisableLineHeightGrid = False
      .FarEastLineBreakControl = True
      .WordWrap = True
      .HangingPunctuation = True
      .HalfWidthPunctuationOnTopOfLine = False
      .AddSpaceBetweenFarEastAndAlpha = True
      .AddSpaceBetweenFarEastAndDigit = True
      .BaseLineAlignment = wdBaselineAlignAuto
   End With
   With ActiveDocument
      .AutoHyphenation = True
      .HyphenateCaps = True
      .HyphenationZone = CentimetersToPoints(0.63)
      .ConsecutiveHyphensLimit = 0
   End With
End Sub
' Âûâîä ñòàòèñòèêè
Private Sub PrintStatistics(intChars As Integer, intWords As Integer, intLines As Integer)
    Selection.EndKey
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="Âðåìÿ, çàòðà÷åííîå íà ÷òåíèå: "
    Selection.TypeParagraph
    Selection.TypeText Text:="Êîëè÷åñòâî ñèìâîëîâ â òåêñòå: " & intChars
    Selection.TypeParagraph
    Selection.TypeText Text:="Êîëè÷åñòâî ñëîâ: " & intWords
    Selection.TypeParagraph
    Selection.TypeText Text:="Êîëè÷åñòâî ñòðîê: " & intLines
End Sub
Vasily.T вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Подсчет количества слов, начинающихся с гласных, согласных, иных символов metagalaxy Общие вопросы C/C++ 4 13.07.2013 14:35
Подсчет количества слов Driver_09 Помощь студентам 2 24.10.2010 17:14
Подсчет: слов и количества символов (C#) freddykruger Помощь студентам 9 28.04.2010 11:29
Подсчет количества слов на листе bukarenko Microsoft Office Excel 4 01.04.2010 12:30