Microsoft Office (Разработка документов в Word, Excel и приложений на Visual Basic for Application). - Учебное пособие (Н.А.Устинов)

Примеры приложений, макросов в microsoft word.

Option Explicit

Public Sub count_word()

   'программа считает слова в тексте

   'проверяем, есть ли выбор текста

   Dim S, s1

   If Selection.Type = wdSelectionIP Then

      'выбора нет , поэтому считаем слова во всем документе

      S = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticWords)

   Else

      'выбор есть, считаем слова в выборе

      S = Selection.Range.ComputeStatistics(wdStatisticWords)

   End If

   s1 = S

   If S > 20 Then s1 = Val(Right(Str(S), 1))

      Select Case s1

         Case 1

             MsgBox "в документе" + Str(S) + " слово"

         Case 2 To 4

             MsgBox "в документе" + Str(S) + " слова"

         Case 5 To 20, 0

             MsgBox "в документе" + Str(S) + " слов"

         Case Else

      End Select

End Sub

 

Public Sub count_lines()

   'программа считает строки в тексте

   'проверяем, есть ли выбор текста

   Dim S, s1

   If Selection.Type = wdSelectionIP Then

      'выбора нет , поэтому считаем слова во всем документе

      S = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticLines)

   Else

      'выбор есть, считаем слова в выборе

      S = Selection.Range.ComputeStatistics(wdStatisticLines)

   End If

   s1 = S

   If S > 20 Then s1 = Val(Right(Str(S), 1))

      Select Case s1

         Case 1

             MsgBox "в документе" + Str(S) + " строка"

         Case 2 To 4

             MsgBox "в документе" + Str(S) + " строки"

         Case 5 To 20, 0

             MsgBox "в документе" + Str(S) + " строк"

         Case Else

      End Select

End Sub

     

Public Sub Use_AddLin()

  Dim oAddIn As Object

    With ActiveDocument.Range(Start:=0, End:=0)

    .InsertAfter "Name" & vbTab & "Path" & vbTab & "Installed"

    .InsertParagraphAfter

    For Each oAddIn In AddIns

        .InsertAfter oAddIn.Name & vbTab & oAddIn.Path & vbTab _

            & oAddIn.Installed

        .InsertParagraphAfter

    Next oAddIn

    .ConvertToTable

  End With

 End Sub

 

Sub FormatLine()

   ' Макрос1 Макрос

   ' Макрос записан 31.03.04 Соков К.,Устинов Н.

   '

   Dim п As Integer ' количество строк в исходном тексте

   Dim Line() As String 'Массив строк

   Dim NewLine() As String 'Массив, содержащий строки отформатированного текста

   Dim k As Integer ' количество слов в абзаце

   Dim W() As String 'Массив слов

   Dim Sl() As String 'Массив ?

   Dim h As Integer ' количество абзацев

   Dim Start()   'Массив № строк, в которых начинаются абзацы

   Dim Finish()  'Массив № строк, в которых заканчиваются абзацы

   Dim i, j As Integer 'индексы

   Dim Newn As Integer '' количество строк в результатном тексте

   Dim nPos As Integer ' позиция

   Dim t As String ' строка

   If Selection.Type = wdSelectionIP Then

      'выбора нет , поэтому считаем строки во всем документе

      n = ActiveDocument.ComputeStatistics(Statistic:=wdStatisticLines)

   Else

      'выбор есть, считаем строки в выборе

      n = Selection.Range.ComputeStatistics(wdStatisticLines)

   End If

   ReDim Line(n) As String 'Массив строк(переопределение)

   ReDim Start(п + 1) 'Массив № строк, в которых начинаются абзацы

   ReDim Finish(n + 1) 'Массив № строк, в которых заканчиваются абзацы

   ReDim W(100) As String 'Массив слов (переопределение)

   h = 0

   'Нахождение № строк, в которых начинаются абзацы

   For i = 1 To n

      If InStr(" ", Line(i)) = 1 Then

          h = h + 1

          Start(h) = i

      End If

   Next i

   Start(h + 1) = n + 1

   'Нахождение № строк, в которых заканчиваются абзацы

   For i = 1 To h

      Finish(i) = i

    Next i

   Newn = 0

   For i = 1 To h

      k = 1

      W(1) = "     "

      For j = 1 To 5      'For j = Start(i) To Finish(i)

         t = Line(i) + " "

         MsgBox "слова абзаца " + t

         While t <> ""

             nPos = InStr(" ", t)

             If nPos > 1 Then

                k = k + 1

                W(k) = Mid$(t, 1, nPos - 1)

                MsgBox "слова абзаца " + Str(k) + "  " + W(k)

            

             End If

             t = Mid$(t, nPos + 1, Len(t) - nPos)

          Wend

       Next j

    Next i

End Sub

Sub formarDoc()

'

' проба1 Макрос

' Макрос записан 16.04.04 Устинов

'

   Dim i As Integer

   Dim h As Integer ' количество абзацев

   Dim WordDoc As Object

  

   If Selection.Type = wdSelectionIP Then

      'выбора нет , поэтому применяем ко всему документу

      h = ActiveDocument.Range.ComputeStatistics(wdStatisticParagraphs)

      For i = 1 To h

         ActiveDocument.Paragraphs(i).Alignment = wdAlignParagraphJustify

         ActiveDocument.Paragraphs(i).FirstLineIndent = CentimetersToPoints(1.27)

      Next i

   Else

      Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify

      Selection.ParagraphFormat.FirstLineIndent = CentimetersToPoints(1.27)

      'выбор есть, применяем для выделенного фрагмента

      'n = Selection.Range.ComputeStatistics(wdStatisticLines)

   End If

End Sub