Страницы: 1
RSS
Из Word несколько строк в excel в одну ячейку
 
Имеется вордовский документ. Хочу её перенести в excel.  
При копировании из ворда  и вставке в эксель, ячейка таблицы ворда, где несколько строк вставляется в эксель разные ячейки друг над другом, как сделать с помощью макроса или других средств, чтоб таблица эксель имела ввид как и ворде?  
 
В прикрепленном файле только часть таблицы ворд, строк на самом деле много ,файл большой
 
Попробуй так.  
 
Sub WordExcel()  
 
   Dim wd As Word.Application  
   Dim doc As Word.Document  
     
   Set wd = New Word.Application  
   Set doc = wd.Documents.Open(ThisWorkbook.Path & "\w.doc")  
     
   doc.Tables(1).Range.Copy  
   Sheet1.PasteSpecial Format:="HTML", Link:=False  
   doc.Close SaveChanges:=False  
   wd.Quit SaveChanges:=False  
 
End Sub
There is no knowledge that is not power
 
прям обязательно макрос? :)  
ручками пару операций выполнить можете?  
 
как вариант:    
в таблице Word заменить символ абзаца на что-нибудь заведомо невстречающееся в тексте, например, "$%$".  
скопировать-вставить в Excel.  
в Excel произвести обратную замену: "$%$" на символ абзаца (в поле "Заменить на" с клавиатуры ввести Alt+010 на цифровой клавиатуре).
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Johny,  
вызвало ошибку  
Set doc = wd.Documents.Open(ThisWorkbook.Path & "\w.doc")  
 
 
ikki,  
Нет не обязательно, указал или другими средствами)  
Так способ Ваш мне понравился, но либо изза того что word 2007 либо изза других причин, не могу в ворде на поиск заменить вставить знак перевода символа , Alt+010 тоже пробывал
 
Tools -> Reference -> Microsoft Word ЦИФРА Object Library.
There is no knowledge that is not power
 
макрос надо вставить в документ ворд:  
 
Sub test()  
   Dim exApp As Object, wb As Object  
   Set exApp = CreateObject("Excel.Application")  
   Set wb = exApp.workbooks.Add  
   Dim c, r  
   For r = 1 To ActiveDocument.Tables.Item(1).Rows.Count  
       For c = 1 To ActiveDocument.Tables.Item(1).Columns.Count  
           With wb.sheets(1).Cells(r, c)  
               .Value = ActiveDocument.Tables.Item(1).Cell(r, c)  
               .Value = Replace(.Value, Chr(7), "")  
               .Value = Replace(.Value, Chr(13), Chr(10))  
           End With  
       Next c  
   Next r  
   exApp.Visible = True  
End Sub
 
Спасибо Всем!  
Всё отлично работает
Страницы: 1
Читают тему
Наверх