импорт данных таблицы word в excel макросом

[Iskin]

Господа, есть постоянная трудность, хотелось бы оптимизироваться. Искал готовые продукты, не нашел...
От Клиента приходят файлы word (пример во вложение), которые нужно перевести в excel, для дальнейшей обработки. А именно значения из таблицы. Я это представляю так. В корень диска С выкладывается файл word. А в excelе кнопка с макросом, которая импортирует все содержимое wordа, переводит в цифровой формат (например 5,950.00 в 5950.00), удаляет "шт." или "шт", удаляет лишние Enter и пустые строки. Остальное можно будет уже ручками поправить.

[Aleksandr H.]

Так а сами что уже сделали для решения трудности? Тут не продукт надо искать, а блоки решения: как подключить ворд к екселю; открыть книгу; пройтись в цикле по таблице; получить значение из ячейки таблицы Ворда.... А тогда после всего - тяп-ляп в один макрос и вуаля

[EducatedFool]

Можно мой парсер настроить под эту задачу:
http://excelvba.ru/programmes/Parser.../WordDocuments

[Iskin]

Сообщение от Aleksandr H.

А тогда после всего - тяп-ляп в один макрос и вуаля

Вуаля не получится. Наример как движком задать условия на удаление пустых строк?...

[Iskin]

тут на сайте нашел один вариант, но он выдает немного другой результат. А что на что поменять, для моей головы уже неизвестно)
Public Function ReturnTextFromWordDocument(ByVal FileName As String) As String
Dim n As Integer
Dim wdApplication As Word.Application
Dim wdDocument As Word.Document

Set wdApplication = CreateObject("Word.Application")

Set wdDocument = wdApplication.Documents.Open(FileNa me)

Dim MyText


MyText = wdDocument.Range.Text


wdDocument.Close
wdApplication.Quit
Dim MyTex As String


ReturnTextFromWordDocument = MyText


End Function


Public Sub Word()
Dim MyText
Dim n, m As Integer
Dim Путь_к_файлу As String
Dim a, b As Integer

Путь_к_файлу = "C:\1.docx" ' пример "C:\1.docx",подставить свой

a = ActiveCell.Column
b = ActiveCell.Row
MyText = Split(ReturnTextFromWordDocument(Пу ть_к_файлу), Chr(13), -1)

For n = 0 To UBound(MyText)

If MyText(n) = "" Then 'Пропуск пустых строк
m = m + 1
GoTo 10

End If

Cells(b + n - m, a) = MyText(n)

10
Next

End Sub