MyTetra Share
Делитесь знаниями!
Загрузка информации из файлов Word (перебор страниц в документе)
31.12.2017
18:17
Текстовые метки: Текстовые файлы, Документы Word,word-excell
Раздел: VBA - Word

Загрузка информации из файлов Word (перебор страниц в документе)

Функция предназначена для вывода информации (статистики) по всем листам документа Word.

 

В качестве параметра, функция получает ссылку на открытый документ Word.

Результат работы функции представлен на скриншоте.

Код функции WordDocumentProperties:

Function DocumentProperties(ByRef doc As Object) As Variant

On Error Resume Next: Err.Clear

' формирует статистику по документу Word

' возвращает двумерный массив из 3 столбцов,

' а строк в массиве столько, сколько страниц в документе DOC.

' 1 столбец: номер страницы + статистика (количество абзацев, слов и букв)

' 2 столбец - текст, с которого начинается страница

' 3 столбец - текст, которым заканчивается страница


Dim pg As Object, oRng As Object, pos1&, pos2&

pc& = doc.Range.Information(4)

ReDim arr(1 To pc&, 1 To 3)

 

For n = 1 To pc&

pos1& = doc.Range.GoTo(1, 2, , n).Start ' wdGoToPage = 1, wdGoToNext = 2

If n = pc& Then

pos2& = doc.Range.End

Else

pos2& = doc.Range.GoTo(1, 2, , n + 1).Start

End If

 

Set oRng = Nothing: Set oRng = doc.Range(pos1&, pos2& - 1)

 

arr(n, 1) = "Страница: " & n & vbLf & _

" абзацев: " & oRng.Paragraphs.Count& & vbLf & _

" символов: " & (pos2& - pos1& - 1)

 

txt = "": txt = Replace(oRng.Text, vbNewLine, " ")

txt1$ = Left(txt, 50): sp& = 0: sp& = InStrRev(txt1, " ")

If sp& > 1 Then txt1 = Left(txt1, sp& - 1)

txt2$ = Right(txt, 50): sp& = 0: sp& = InStr(1, txt2, " ")

If sp& > 1 Then txt2 = Mid(txt2, sp& + 1)

arr(n, 2) = Trim(Application.Trim(Application.Clean(txt1)))

arr(n, 3) = Trim(Application.Trim(Application.Clean(txt2))) 'Replace(txt2, Chr(13), vbLf)

Next

DocumentProperties = arr

End Function



Пример вызова функции из другого макроса:

' загружаем данные из файла Word

Set doc = Nothing

Set doc = WA.Documents.Open(filename$, , True)

 

If doc Is Nothing Then ' если документ не открылся

cell.Resize(, 5).Value = Array(index&, ShortFilename$, subfolder$, DateCreated, FileSize&)

cell.Offset(, 5) = "Не удалось открыть файл DOC"

 

Else ' документ успешно открыт

arr = "": arr = DocumentProperties(doc)

 

If IsArray(arr) Then ' если удалось загрузить данные из документа Word

cell.Resize(UBound(arr), 5).Value = Array(index&, ShortFilename$, subfolder$, DateCreated, FileSize&)

cell.Offset(, 5).Resize(UBound(arr), 3).Value = arr ' выводим результаты на лист

Else

cell.Resize(, 5).Value = Array(index&, ShortFilename$, subfolder$, DateCreated, FileSize&)

cell.Offset(, 5) = "Не удалось загрузить данные из файла"

End If

doc.Close False ' закрываем файл DOC

End If

  • 7335 просмотров
Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования