1

Тема: Преобразование текста из Frame в обычный текст

Добрый день!
Подскажите по очень важному вопросу. Из учетной программы выгружается документ где все предложения или абзацы находятся в отдельных фреймах Frame и Shape. Невозможно ничего сделать с документом. Хотелось бы чтобы макрос мог сделать документ так как он выглядит на печати но без фреймов, а как обычный построчный текст. Также хотелось бы чтобы внизу где реквизиты работодателя и работника создавалась таблица без видимых границ. Также очень важно сохранить все исходное форматирование (жирность, подчеркивание и т.д.)
Есть вот такой код.

Sub test()
Dim TabHourFrames() As Variant
numb_frames = ActiveDocument.Frames.Count
    ReDim TabHourFrames(1 To numb_frames)
    counter = numb_frames
    For i = 1 To counter
        Set myRange = ActiveDocument.Frames.Item(i).Range
        t = myRange.Text
        TabHourFrames(i) = t
    Next i
 Documents.Add DocumentType:=wdNewBlankDocument
        For q = 1 To counter
        last_par = ActiveDocument.Paragraphs.Count
        Set rngLastParagraph = ActiveDocument.Paragraphs(last_par).Range
            With rngLastParagraph
                    .InsertAfter Text:=TabHourFrames(q)
                    .InsertParagraphAfter
            End With
        Next q
ActiveDocument.Range(0, 0).Select
End Sub

По поиску нашел еще вот такую подобную вещь. Но это не совсем то так как переводит в таблицу все фреймы.

Sub CreateTable()
    Dim oS As Frame
    Dim sH As String, sV As String, sHeiht As String, sWidth As String, colH As Collection, le As Long, i As Long
    Dim avTmp, lMaxColscnt As Long
    Dim dicFrames As Object
    Dim avItems, avKeys
    Dim docNew As Document, oTbl As Table
    'словарь рамок
    Set dicFrames = CreateObject("scripting.dictionary")
    dicFrames.comparemode = 1
    On Error Resume Next
    For Each oS In ActiveDocument.Frames
        sH = oS.HorizontalPosition
        sV = oS.VerticalPosition
        sHeiht = oS.Height 'вдруг пригодится
        sWidth = oS.Width 'вдруг пригодится
        avTmp = Array(sH, oS.Range.Text, sHeiht, sWidth)
        If dicFrames.Exists(sV) = False Then
            Set colH = New Collection
            colH.Add avTmp, sH
            dicFrames.Add sV, colH
        Else
            Set colH = dicFrames.Item(sV)
            'сортируем столбцы
            For i = 1 To colH.Count
                If CDbl(sH) < CDbl(colH.Item(i)(0)) Then Exit For
            Next
            
            If i > colH.Count Then
                colH.Add avTmp, sH
                If Err.Number Then
                    avTmp = Array(sH, avTmp(1) & oS.Range.Text, sHeiht, sWidth)
                    colH.Item(i) = avTmp
                    Err.Clear
                End If
            Else
                colH.Add avTmp, sH, Before:=i
                If Err.Number Then
                    avTmp = Array(sH, avTmp(1) & oS.Range.Text, sHeiht, sWidth)
                    colH.Item(i) = avTmp
                    Err.Clear
                End If
            End If
            Set dicFrames.Item(sV) = colH
            If colH.Count > lMaxColscnt Then
                lMaxColscnt = colH.Count
            End If
        End If
    Next
    'выгружаем на новую таблицу в новом документе
    On Error GoTo 0
    avItems = dicFrames.items
    avKeys = dicFrames.keys
    Set docNew = Documents.Add
    Set oTbl = docNew.Tables.Add(docNew.Content, UBound(avKeys), lMaxColscnt)
    On Error GoTo 0
    For le = LBound(avKeys) To UBound(avKeys)
        Set colH = dicFrames.Item(avKeys(le))
        For i = 1 To colH.Count
            oTbl.Cell(le + 1, i).Range.Text = colH.Item(i)(1)
        Next i
    Next le
End Sub

Файл во вложении. Помогите пожалуйста)
С уважением, Оксана.

Post's attachments

urp1bc4 — копия.rtf 86.92 Кб, 4 скачиваний с 2016-10-27 

You don't have the permssions to download the attachments of this post.

2

Re: Преобразование текста из Frame в обычный текст

dimonbk пишет:

...
Невозможно ничего сделать с документом.
...

Попробуйте упростить входные данные. Например, пересохраните ваш документ в текстовом формате (.txt), а затем откройте новый файл в Word - думаю, из такого формата все необходимые данные вам будет извлечь легче.

3

Re: Преобразование текста из Frame в обычный текст

yshindin пишет:
dimonbk пишет:

...
Невозможно ничего сделать с документом.
...

Попробуйте упростить входные данные. Например, пересохраните ваш документ в текстовом формате (.txt), а затем откройте новый файл в Word - думаю, из такого формата все необходимые данные вам будет извлечь легче.

Такой вариант не подходит. Это тоже самое что применить Activedocument.Frames(i).delete к каждому фрейму. Дело в том что фреймы распологаются не по порядку в документе, т.е. последний номер фрейма может быть в начале документа. А в txt он сохраняет фреймы по порядку. Да и форматирование слетает.

4

Re: Преобразование текста из Frame в обычный текст

dimonbk пишет:

...
Дело в том что фреймы распологаются не по порядку в документе, т.е. последний номер фрейма может быть в начале документа. А в txt он сохраняет фреймы по порядку.
...

Насколько я понял, ваш документ генерится каким-то приложением, использующим VBA в среде Word. Самое простое - попросить разработчика этого приложения выдавать документ в нужном вам виде без фреймов и объектов-фигур. Другой подход - генерить самому нужный вам документ из документа с фреймами, зная что 5-й фрейм содержит такую-то информацию, 7-й - такую-то. Поэтому я предложил поискать вариант конвертации исходного документа в другой формат. Можно даже Excel попробовать - при копировании вашего документа в Exсel все будет разложено по полочкам - т.е, каждый кусок исходных данных попадет в отдельную ячейку Excel. Причем, напр., фамилия гражданина всегда будет попадать в ячейку с одним и тем же номером, независимо от исходного документа. Проверьте это, а потом приступайте к извлечению данных (для чего придется писать совсем другой макрос).

5

Re: Преобразование текста из Frame в обычный текст

yshindin пишет:

Насколько я понял, ваш документ генерится каким-то приложением, использующим VBA в среде Word. Самое простое - попросить разработчика этого приложения выдавать документ в нужном вам виде без фреймов и объектов-фигур. Другой подход - генерить самому нужный вам документ из документа с фреймами, зная что 5-й фрейм содержит такую-то информацию, 7-й - такую-то. Поэтому я предложил поискать вариант конвертации исходного документа в другой формат. Можно даже Excel попробовать - при копировании вашего документа в Exсel все будет разложено по полочкам - т.е, каждый кусок исходных данных попадет в отдельную ячейку Excel. Причем, напр., фамилия гражданина всегда будет попадать в ячейку с одним и тем же номером, независимо от исходного документа. Проверьте это, а потом приступайте к извлечению данных (для чего придется писать совсем другой макрос).

Документ генерится Парусом, с разработчиками невозможно решить вопрос. В excel копирует но по тому же принципу что и txt. И опять же нужно сохранить форматирование. excel по сути тоже самое что и просто к каждому фрейму обращаться, т.е. лишние хлопоты.

6

Re: Преобразование текста из Frame в обычный текст

dimonbk пишет:

Добрый день!
Подскажите по очень важному вопросу. Из учетной программы выгружается документ где все предложения или абзацы находятся в отдельных фреймах Frame и Shape. Невозможно ничего сделать с документом. Хотелось бы чтобы макрос мог сделать документ так как он выглядит на печати но без фреймов, а как обычный построчный текст. Также хотелось бы чтобы внизу где реквизиты работодателя и работника создавалась таблица без видимых границ. Также очень важно сохранить все исходное форматирование (жирность, подчеркивание и т.д.)
Есть вот такой код.

Sub test()
Dim TabHourFrames() As Variant
numb_frames = ActiveDocument.Frames.Count
    ReDim TabHourFrames(1 To numb_frames)
    counter = numb_frames
    For i = 1 To counter
        Set myRange = ActiveDocument.Frames.Item(i).Range
        t = myRange.Text
        TabHourFrames(i) = t
    Next i
 Documents.Add DocumentType:=wdNewBlankDocument
        For q = 1 To counter
        last_par = ActiveDocument.Paragraphs.Count
        Set rngLastParagraph = ActiveDocument.Paragraphs(last_par).Range
            With rngLastParagraph
                    .InsertAfter Text:=TabHourFrames(q)
                    .InsertParagraphAfter
            End With
        Next q
ActiveDocument.Range(0, 0).Select
End Sub

По поиску нашел еще вот такую подобную вещь. Но это не совсем то так как переводит в таблицу все фреймы.

Sub CreateTable()
    Dim oS As Frame
    Dim sH As String, sV As String, sHeiht As String, sWidth As String, colH As Collection, le As Long, i As Long
    Dim avTmp, lMaxColscnt As Long
    Dim dicFrames As Object
    Dim avItems, avKeys
    Dim docNew As Document, oTbl As Table
    'словарь рамок
    Set dicFrames = CreateObject("scripting.dictionary")
    dicFrames.comparemode = 1
    On Error Resume Next
    For Each oS In ActiveDocument.Frames
        sH = oS.HorizontalPosition
        sV = oS.VerticalPosition
        sHeiht = oS.Height 'вдруг пригодится
        sWidth = oS.Width 'вдруг пригодится
        avTmp = Array(sH, oS.Range.Text, sHeiht, sWidth)
        If dicFrames.Exists(sV) = False Then
            Set colH = New Collection
            colH.Add avTmp, sH
            dicFrames.Add sV, colH
        Else
            Set colH = dicFrames.Item(sV)
            'сортируем столбцы
            For i = 1 To colH.Count
                If CDbl(sH) < CDbl(colH.Item(i)(0)) Then Exit For
            Next
            
            If i > colH.Count Then
                colH.Add avTmp, sH
                If Err.Number Then
                    avTmp = Array(sH, avTmp(1) & oS.Range.Text, sHeiht, sWidth)
                    colH.Item(i) = avTmp
                    Err.Clear
                End If
            Else
                colH.Add avTmp, sH, Before:=i
                If Err.Number Then
                    avTmp = Array(sH, avTmp(1) & oS.Range.Text, sHeiht, sWidth)
                    colH.Item(i) = avTmp
                    Err.Clear
                End If
            End If
            Set dicFrames.Item(sV) = colH
            If colH.Count > lMaxColscnt Then
                lMaxColscnt = colH.Count
            End If
        End If
    Next
    'выгружаем на новую таблицу в новом документе
    On Error GoTo 0
    avItems = dicFrames.items
    avKeys = dicFrames.keys
    Set docNew = Documents.Add
    Set oTbl = docNew.Tables.Add(docNew.Content, UBound(avKeys), lMaxColscnt)
    On Error GoTo 0
    For le = LBound(avKeys) To UBound(avKeys)
        Set colH = dicFrames.Item(avKeys(le))
        For i = 1 To colH.Count
            oTbl.Cell(le + 1, i).Range.Text = colH.Item(i)(1)
        Next i
    Next le
End Sub

Файл во вложении. Помогите пожалуйста)
С уважением, Оксана.

Добрый день, макрос фреймы отправляет в таблицу, а что с ними сделать нужно вам? Удалить фрейм и вставить на его место текст данного фрейма? Можно просто код подкорректировать.
П.С.: У вас Оксана затесалась big_smile

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

7

Re: Преобразование текста из Frame в обычный текст

Fck_This пишет:

Добрый день, макрос фреймы отправляет в таблицу, а что с ними сделать нужно вам? Удалить фрейм и вставить на его место текст данного фрейма? Можно просто код подкорректировать.
П.С.: У вас Оксана затесалась big_smile

Да. Нужно удалить фрейм и вставить на его место текст с тем же форматированием. И расположить также как и сейчас есть.
П.С. я и есть Оксана, что значит затесалась?

8

Re: Преобразование текста из Frame в обычный текст

dimonbk пишет:
Fck_This пишет:

Добрый день, макрос фреймы отправляет в таблицу, а что с ними сделать нужно вам? Удалить фрейм и вставить на его место текст данного фрейма? Можно просто код подкорректировать.
П.С.: У вас Оксана затесалась big_smile

Да. Нужно удалить фрейм и вставить на его место текст с тем же форматированием. И расположить также как и сейчас есть.
П.С. я и есть Оксана, что значит затесалась?

Завтра с утра посмотрю код, можно ли там чего исправить.
Не обращайте внимания. Думаю, форум - не то место, чтобы вдаваться в подробности.

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

9

Re: Преобразование текста из Frame в обычный текст

Fck_This пишет:

Завтра с утра посмотрю код, можно ли там чего исправить.
Не обращайте внимания. Думаю, форум - не то место, чтобы вдаваться в подробности.

Спасибки))

10

Re: Преобразование текста из Frame в обычный текст

Fck_This пишет:
dimonbk пишет:
Fck_This пишет:

Добрый день, макрос фреймы отправляет в таблицу, а что с ними сделать нужно вам? Удалить фрейм и вставить на его место текст данного фрейма? Можно просто код подкорректировать.
П.С.: У вас Оксана затесалась big_smile

Да. Нужно удалить фрейм и вставить на его место текст с тем же форматированием. И расположить также как и сейчас есть.
П.С. я и есть Оксана, что значит затесалась?

Завтра с утра посмотрю код, можно ли там чего исправить.
Не обращайте внимания. Думаю, форум - не то место, чтобы вдаваться в подробности.

ну что? не поможете?((