превращение ячеек Excel в текст Word

  • Автор темы rustamh
  • Дата начала
R

rustamh

#1
Погомите пожалуйста решить задачу Excel!! Есть несколько параллельных столбцов в таблице. Мне нужно получить из них сплошной текст. Сейчас я переношу просто нужные столбцы в Word и делаю там "объединить ячейки". В результате получается сплошной текст - вместо столбиков - знаки абзацев. Потом я делаю "Найти и заменить" и заменяю все абзацы на пробелы. Можно ли сделать так, чтобы в Excele была одна кнопочка, при нажатии на которую выделенные ячейки превращались бы в сплошной удобный текст (в Worde или в блокноте? Если да напишите пожалуйста как это сделать. Заранее спасибо.
 
T

Tanya

#2
Конечно можно такое сделать, но только знать бы в Worde или в блокноте? то есть в каком же все же виде должно быть )))

В общем перебрасываем в Word.

Код:
Sub RangeToWord()
Dim i As Integer, j As Integer
Dim s As String
Dim Wrd As Object

'получаем текст всего листа
With ActiveSheet.UsedRange
For i = .Column To .Column + .Columns.Count
For j = .Row To .Row + .Rows.Count
'пропускаем пустые ячейки
If Len(.Cells(j, i).Value) Then
s = s & .Cells(j, i).Value & " "
End If
Next j
Next i
End With

'активируем ворд
Application.ActivateMicrosoftApp xlMicrosoftWord
Set Wrd = GetObject(, "Word.Application")

If Not Wrd Is Nothing Then
'если нет открытых документов, то создаем новый
If Wrd.Documents.Count = 0 Then
Wrd.Documents.Add.ActiveWindow.Activate
End If

'в позицию курсора вставляем текст
Wrd.ActiveWindow.Selection.TypeText Text:=s + vbCrLf

'закрываем ссылку на ворд
Set Wrd = Nothing
End If
End Sub
Дальше создаем кнопку и вешаем на нее этот макрос
 
R

rustamh

#3
Tanya - это просто чудо. 2 раза в жизни я обращался за помощью к форумам - и оба раза мне помогала Таня!!! Спасибо большое!!!
 
R

rustamh

#5
Таня, а можно проделать все то же самое - только чтобы в Word форматирование сохранилось. Например - если в разных столбцах Excel стоят разные шрифты с разными размерами - то что бы в Word они отображались также.
 
T

Tanya

#6
Можно, есть вариант, только теперь - гораздо меделеннее )))
Код:
Sub RangeToWord()

Dim i As Integer, j As Integer
Dim s As String
Dim Wrd As Object 

Application.ActivateMicrosoftApp xlMicrosoftWord
Set Wrd = GetObject(, "Word.Application")
If Not Wrd Is Nothing Then
If Wrd.Documents.Count = 0 Then
Wrd.Documents.Add.ActiveWindow.Activate
End If

With ActiveSheet.UsedRange
For j = .Row To .Row + .Rows.Count		  
For i = .Column To .Column + .Columns.Count
If Len(.Cells(j, i).Value) Then
Wrd.ActiveWindow.Selection.Font.Bold = .Cells(j, i).Font.Bold

'тут подстава))) с их индивидуальными константами в зависимости от приложения!
If .Cells(j, i).Font.Underline = xlUnderlineStyleSingle Then
Wrd.ActiveWindow.Selection.Font.Underline = 1 'wdUnderlineSingle
Else
Wrd.ActiveWindow.Selection.Font.Underline = 0
End If

Wrd.ActiveWindow.Selection.Font.Size = .Cells(j, i).Font.Size
Wrd.ActiveWindow.Selection.Font.Strikethrough = .Cells(j, i).Font.Strikethrough
Wrd.ActiveWindow.Selection.Font.Italic = .Cells(j, i).Font.Italic
Wrd.ActiveWindow.Selection.Font.Color = .Cells(j, i).Font.Color

Wrd.ActiveWindow.Selection.TypeText Text:=.Cells(j, i).Value & " "
End If
Next i
Next j

Wrd.ActiveWindow.Selection.TypeText vbCrLf
End With

'закрываем ссылку на ворд
Set Wrd = Nothing
End If
End Sub
Думаю, что даже за такой медленный вариант достойна +1 :blink:
 
R

rustamh

#7
Таня, ты за предыдущую подсказку точно заработала +10 (только я не знаю как тебе добавить эти баллы). а вот последний вариант у меня не работает :-( . А ты могла бы посмотреть мой конкретный пример Excel и попробовать помочь мне? Очень нужна помощь специалиста. Суть в том, чтобы объединить ячейки файла shablon.xls в сплошной текст. Загвоздка еще в том, что таблица содержит в разных столбцах разные направления письма (справа на лево и с лева направо). В итоговом Worde это тоже должно сохраниться. А последнее решение, которые ты мне дала - вообще не работает никак. Останавливается на одной строке и выдает ошибку. Заранее благодарен.
 
T

Tanya

#8
Совершенно верно, в предыдущем примере я пропустила обработчик ошибок и не учла некоторые тонкости при установке шрифта.
То что ты хочешь, так как я это делала решить сложно. Проще всего сделать именно так как ты и просил сначала:
копируем, вставляем и заменяем )))) и не нужно ничего выдумывать нового )))

Код:
Sub RangeToWord2()

Dim Wrd As Object 'получаем текст всего листа

'перехват ошибки
On Error Resume Next

'активируем ворд
Application.ActivateMicrosoftApp xlMicrosoftWord
Set Wrd = GetObject(, "Word.Application")

If Wrd Is Nothing Then
Set Wrd = CreateObject("Word.Application")
End If

If Not Wrd Is Nothing Then
'если нет открытых документов, то создаем новый
If Wrd.Documents.Count = 0 Then
Wrd.Documents.Add.ActiveWindow.Activate
End If

ActiveSheet.UsedRange.Copy

'Wrd.ActiveWindow.Selection.PasteExcelTable False, False, False
With Wrd.ActiveDocument
.Range.PasteExcelTable False, False, False
.Tables(1).ConvertToText Separator:=3, NestedTables:=True

With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting

'заменяем абзацы
.Execute FindText:="^p", Replace:=2, ReplaceWith:=" "

'Дальше, при необходимости можно удалить
'заменяем двойные пробелы на одинарные
.Execute FindText:=" ", Replace:=2, ReplaceWith:=" "
'и на всякий случай еще раз
.Execute FindText:=" ", Replace:=2, ReplaceWith:=" "
End With

'перемещаем выделение на начало документа
.Range(Start:=.Range.Start, End:=.Range.Start).Select
End With

'закрываем ссылку на ворд
Set Wrd = Nothing
End If
End Sub
На твоем примере вроде отработало нормально. Но все может быть )))) могут быть и ошибки ...
 
R

rustamh

#9
Спасибо большое! Как я могу отблагодарить тебя?
Все работает отлично. А проделать все то же самое для блокнота сложно? Когда я просто вставляю в блокнот текст из Word - получается ерунда - скобки и другие значки отображаются неверно.
Мне уже неловко тревожить тебя - но все-таки, можно я буду тебе писать по дальшейшей доработке макроса? Просто если самому разбираться во всем этом - может несколько дней уйти - а тебе наверное для этого минуты нужны.
Еще раз большое спасибо :)
 
T

Tanya

#10
Насчет минут - ты не прав, мне тоже нужно некоторое количество времени
потомучто я не работаю с VBA, когда-то работала с VBA Excel, в Word пытаюсь по аналогии,
но Word прилично отличается от Excel (хотя, казалось бы )))))

Для блокнота так не сделаешь, потомучто там один шрифт, одна кодировка, а в твоем тексте разные настройки.
К тому же в макросе используются классы приложений Excel и Word, а объектной модели Блокнота, насколько я знаю - нет.

А смысл делать для блокнота?
 
R

rustamh

#11
если делать для блакнота - то не требуется сохранение размера шрифтов. просто хотя бы чтобы скобки адекватно отображились. если например из Word скопировать и вставить в блакнот - получается фигня. Скобки сбиваются например. Просто некоторые види словарей вроде QDictionary работают в блакнотовском формате. и поэтому текст надо и под них подогнать. А то мне уже как то неловко. А вообще ты очень хорошо помогла, спасибо большое. Твои макросы я уже думаю без проблем буду менять и добиваться разных нужных результатов.
Таня, ты прости пожалуйста, что столько много просьб - но если можно посмотри пожалуйста, что можно сделать для конвертации в Блокнот. Итоговый текст должен иметь вид как в файле http://ar-ru.ru/baranov_21-23.txt
Суть в том, что в блокноте когда набираешь текс, надо правой кнопкой управляющие символы Уникода какие-то вставлять. А в экселе и ворде это все по другому делается - просто печатаешь разными раскладками да и все.
Может ты знаешь как можно посмотреть код текста в блакноте? может быть можно взять за основу коды символов в блокноте и в ворде и пометь их?