Как в MS Word получить Left и Top слова.

[SergT]

Доброе время суток всем форумчанам. Прошу помощи в возникшей проблеме.
Суть проблемы:
Необходимо получить из существующего документа координаты всех его слов. Т.е. Left и Top для дальнейшего переноса этих слов в виде Labels на форму. Иными словами "скопировать" содержимое одной страницы (А4) документа на форму, но в виде Labels, учитывая их позицию в соответствии с позицией слов в тексте и, желательно, параметры Font-а. Возможные Таблицы рассматривать так же как простой текст.
Предполагается, что (для облегчения задачи) документ можно сохранить в любой известный формат: doc, rtf, xml и т.д.
Заранее благодарен любым, даже самым невероятным предложениям. Или обоснованию, что это сделать нельзя!

[alibek]

Или обоснованию, что это сделать нельзя!

Чтобы это сделать, нужно воспроизвести весь рендеринг Word. Т.е. написать процентов 70% его функционала. Справишься?
Решаемой задача будет только с оговорками и конкретными требованиями.

[SergT]

Нет, не справлюсь. Достаточно ответа -"Это невозможно, так как противоречит условиям, иложенным [ссылка]"
Оговорки и жесткие ограничения готов принять!

[alibek]

Ну тогда разбирайся с Selection.Information(wdHorizontalPositionRelativeToPage) и Selection.Information(wdVerticalPositionRelativeToPage).

[SergT]

Уф! Не просто это, читаю ...
Спасибо. А может сохранить doc в другой формат и вытащить эту информацию из какого либо другого известного формата? Рассматривал xml и rtf. Там кое что есть, но ... Сделать что-то вроде парсера?

[SergT]

Ну тогда разбирайся с Selection.Information(wdHorizontalPositionRelativeToPage) и Selection.Information(wdVerticalPositionRelativeToPage).

Пожалуй, это наиболее удачное решение! alibek - откуда ты все это знаешь? .

[SergT]

Собственно, родился первый макрос:

Код: Выделить всё

Sub GET_LeftTopFont()
Dim x As Single, y As Single, s$, i&
Dim AD As Document
Dim SF$, CurPage%
Dim wd As Word.Range
   Set AD = ActiveDocument

For Each wd In ActiveDocument.Words 'проходим по всем словам в документе
    wd.Select
    CurPage = Selection.Information(wdActiveEndAdjustedPageNumber)
    If CurPage > 1 Then Exit For ' Нам нужен только первый лист
    '1 point=20 twip
    ' Нам нужены данные в twip

    x = Selection.Information(wdHorizontalPositionRelativeToPage)
    y = Selection.Information(wdVerticalPositionRelativeToPage)
    s = wd.Text
    ' Убираем "мусор"
    s = Replace(s, vbCr, ""): s = Replace(s, vbLf, "")
    s = Replace(s, vbTab, ""): s = Replace(s, Chr(11), "")
    s = Replace(s, Chr(160), ""): s = Replace(s, ";", ":,")
        If Trim(s) <> "" Then
    'MsgBox "x=" & x * 20 & "; y=" & y * 20 & ", wd.text=" & s & " | Font,Size,Bold=" & wd.Font.Name & "," & wd.Font.Size & "," & wd.Font.Bold
    SF = SF & x * 20 & ";" & y * 20 & ";" & s & ";" & wd.Font.Name & ";" & wd.Font.Size & ";" & IIf(wd.Font.Bold = 0, False, True) & vbCrLf
    'MsgBox Asc(s)
    End If
    s = ""
Next
'Сливаем результат в файл csv, его можно использовать как таблицу БД

s = AD.FullName & ".csv"
Open s For Output As #1
    Print #1, SF
Close #1
MsgBox "Saved as :" & vbCrLf & s
' PS: Ширину и высоту текста получим после передачи его в Label, у которого AutoSize = True
End Sub