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

Тема в разделе "Visual Basic", создана пользователем rustamh, 13 сен 2008.

  1. rustamh

    rustamh Гость

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

    Tanya Гость

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

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

    Код (Text):
    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
    Дальше создаем кнопку и вешаем на нее этот макрос
     
  3. rustamh

    rustamh Гость

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

    Tanya Гость

    ))) на здоровье!
     
  5. rustamh

    rustamh Гость

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

    Tanya Гость

    Можно, есть вариант, только теперь - гораздо меделеннее )))
    Код (Text):
    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:
     
  7. rustamh

    rustamh Гость

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

    Tanya Гость

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

    Код (Text):
    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
    На твоем примере вроде отработало нормально. Но все может быть )))) могут быть и ошибки ...
     
  9. rustamh

    rustamh Гость

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

    Tanya Гость

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

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

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

    rustamh Гость

    если делать для блакнота - то не требуется сохранение размера шрифтов. просто хотя бы чтобы скобки адекватно отображились. если например из Word скопировать и вставить в блакнот - получается фигня. Скобки сбиваются например. Просто некоторые види словарей вроде QDictionary работают в блакнотовском формате. и поэтому текст надо и под них подогнать. А то мне уже как то неловко. А вообще ты очень хорошо помогла, спасибо большое. Твои макросы я уже думаю без проблем буду менять и добиваться разных нужных результатов.
    Таня, ты прости пожалуйста, что столько много просьб - но если можно посмотри пожалуйста, что можно сделать для конвертации в Блокнот. Итоговый текст должен иметь вид как в файле http://ar-ru.ru/baranov_21-23.txt
    Суть в том, что в блокноте когда набираешь текс, надо правой кнопкой управляющие символы Уникода какие-то вставлять. А в экселе и ворде это все по другому делается - просто печатаешь разными раскладками да и все.
    Может ты знаешь как можно посмотреть код текста в блакноте? может быть можно взять за основу коды символов в блокноте и в ворде и пометь их?
     
Загрузка...
Похожие Темы - превращение ячеек Excel
  1. aborigen12345
    Ответов:
    0
    Просмотров:
    337
  2. alik86
    Ответов:
    28
    Просмотров:
    7.046
  3. BIFF99
    Ответов:
    2
    Просмотров:
    1.638
  4. Shaminem
    Ответов:
    1
    Просмотров:
    1.339
  5. Ryuujin
    Ответов:
    3
    Просмотров:
    1.671

Поделиться этой страницей