Вставка текста в несколько файлов - VBA

Узнай цену своей работы

Формулировка задачи:

Нужно вставить фрагмент (строку) текста в несколько файлов. Не могу понять, что не получается. Помогите, люди добрые
Листинг программы
  1. Sub Insert()
  2. On Error Resume Next
  3. Dim picker As New FilePicker
  4. Dim wordApp As Application
  5. Dim wordDocument As Word.Document
  6. picker.pickFile "Word files", Array("*.doc;*.docx;*.docm")
  7. If UBound(picker.items) < 0 Then: Exit Sub
  8.  
  9. Set wordApp = New Application
  10. wordApp.Visible = True
  11. Application.DisplayAlerts = wdAlertsNone
  12. wordApp.DisplayAlerts = wdAlertsNone
  13. For Each FileName In picker.items
  14. Set wordDocument = wordApp.Documents.Open(FileName)
  15. With wordDocument
  16. Selection.MoveDown Unit:=wdLine, Count:=1
  17. Selection.TypeText Text:="=====+++++======"
  18. End With
  19. wordDocument.Close SaveChanges:=True
  20. Next
  21. wordApp.Quit
  22. End Sub

Решение задачи: «Вставка текста в несколько файлов»

textual
Листинг программы
  1.   Dim pageRange As Range, i&
  2.     ' определение начала требуемой страницы - 5
  3.    Set pageRange = ActiveDocument.Range.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=5)
  4.     ' позиция первого символа следующей страницы
  5.    i = pageRange.GoToNext(wdGoToPage).End
  6.     ' определение диаппазона страницы
  7.    If pageRange.Start = i Then
  8.         ' последняя страница
  9.        pageRange.End = ActiveDocument.Range.End ' диаппазон до конца документа
  10.    Else
  11.         ' существует страница после
  12.        pageRange.End = i - 1   ' диаппазон до начала следующей страницы
  13.    End If
  14.    
  15.     pageRange.ParagraphFormat.LineSpacing = 14 ' устанавливаем межстрочный интервал
  16.    ' удаляем надписи
  17.    For i = 1 To pageRange.ShapeRange.Count
  18.         pageRange.ShapeRange(1).Delete
  19.     Next

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 3.889 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут