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

Конечно можно такое сделать, но только знать бы в 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

Дальше создаем кнопку и вешаем на нее этот макрос

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

))) на здоровье!

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

Можно, есть вариант, только теперь - гораздо меделеннее )))

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

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

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

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

На твоем примере вроде отработало нормально. Но все может быть )))) могут быть и ошибки ...

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

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

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

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

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