Макрос для копирования

[knyz]

Мне нужно делать вставку текста в ворд с определенным форматированием, тоесть шрифт такой, прописные, первая буква предложения заглавная. Вот и прошу помощи у спецов !

По моему это уже надо в другой теме задавать, есть настройка параметров вставки в ворд по умолчанию?

[Serge_Bliznykov]

1) что в вашем понимании "с определённым форматированием" ?
2) чем не устраивает Selection.Copy
3) как именно Вы вставляете в Word? руками?
в принципе, попробуйте в ворд включить Макрос -Запись - потом
вставьте текст и отформатируйте. завершить запись. получите готовый макрос ;-)

[SAS888]

Если я правильно понял, то нужно скопировать содержимое ячейки (объединенной или нет, не важно) в документ Word в виде текста (не таблицы) с сохранением всего того ( формат, шрифт, цвет и т.д.), что было подготовлено в копируемой ячейке?
Если так, то посмотрите вложение. Пусть, например, есть файл "Test.doc", который находится в той же папке, что и наш xls-файл. Выделить подготовленную ячейку и нажать кнопку. Макрос откроет Word, откроет "Test.doc" и скопирует требуемый текст в позицию курсора. В коде подробные комментарии. В целях упрощения, не производится никаких проверок (открыт ли файл, существует ли файл и т.д.). Если нужно - добавьте по мере надобности.

[дмидми]

SAS888,
я бы не связывался с SendKeys без крайней необходимости.
SendKeys "^{Insert}", True 'Копируем в буфер обмена выделенный диапазон в Excel
можно заменить на
Selection.Copy
, а
SendKeys "+{Insert}", True 'Вставляем в Word данные из буфера обмена
можно заменить на
Selection.PasteExcelTable False, False, False
. Кроме того, при копировании одной ячейки Word не создаёт таблицу (вставляется просто параграф).

Получилось

Sub CopyFromExcelToWord()
    Dim wdApp As Object, wdDoc As Object
'''    SendKeys "^{Insert}", True 'Копируем в буфер обмена выделенный диапазон в Excel
    Selection.Copy  '''
'Открываем Word и файл "Test" (позднее связывание)
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Test.doc")
    wdApp.Visible = True: wdApp.Activate
'''    SendKeys "+{Insert}", True 'Вставляем в Word данные из буфера обмена
    Selection.PasteExcelTable False, False, False   '''
    Application.CutCopyMode = False '''
''''Убираем таблицу, сохраняя формат данных
'''    With wdApp
'''        .Selection.GoTo What:=wdGoToTable
'''        .Selection.Rows.ConvertToText
'''    End With
'Уничтожим созданные объекты (освобождая используемую память)
    Set wdApp = Nothing
    Set wdDoc = Nothing
End Sub

[VictorM]

в коде, приведенном дмидми, у меня VBE почему-то "ругается" на строку

Selection.PasteExcelTable False, False, False

заменил на

Call wdDoc.Range.PasteExcelTable(False, False, False)

все заработало...

[SAS888]

дмидми. Соглашусь с Вами. Хотя, разницы не вижу. Все, что здесь предлагается, это, так сказать, наброски (болванки), руководство к действию. С одной ячейкой, тоже все в порядке (см.вложение). А с методом "SendKeys", действительно, нужно следить за тем, какое приложение активно, или использовать ожидание ( ,True). Т.е. Ваш код рациональнее (но это не говорит о том, что мой не рабочий).

[knyz]

Сообщение от Serge_Bliznykov

1) что в вашем понимании "с определённым форматированием" ?
2) чем не устраивает Selection.Copy
3) как именно Вы вставляете в Word? руками?
в принципе, попробуйте в ворд включить Макрос -Запись - потом
вставьте текст и отформатируйте. завершить запись. получите готовый макрос ;-)

1) Должен сохраниться размер и название шрифта.
2) Selection.Copy копирует ячейку как ячейку таблицы (рамку), а она мне в ворде не нужна.
3)В ворде я выбираю место куда надо вставить и нажимаю "вставить"


Вот весь код :

 'слияние ячеек без удаления текста
 Sub MergeToOneCell()
    Dim MyDataObj As New DataObject
    Dim S As String
    Const sDELIM As String = ", "
    Dim rCell As Range
    Dim sMergeStr As String
    If TypeName(Selection) <> "Range" Then Exit Sub
    If Not Status Then Exit Sub
    Call SaveUndoInfo(Selection)
    With Selection
        For Each rCell In .Cells
            sMergeStr = sMergeStr & sDELIM & rCell.Text
        Next rCell
        Application.DisplayAlerts = False
        .Merge Across:=False
        Application.DisplayAlerts = True
        .Item(1).Value = Mid(sMergeStr, 1 + Len(sDELIM))
        ActiveCell.Formula = Mid(sMergeStr, 1 + Len(sDELIM))
       

 With ActiveCell.Characters(Start:=1, Length:=25).Font
        .Name = "Arial"
        .FontStyle = "обычный"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
       
        
    End With
    
    S = LCase(CStr(ActiveCell.Value))
    MyDataObj.SetText S
    MyDataObj.PutInClipboard
        
        
    End With
    
 End Sub

Я расчитывал что сохраниться форматирование текста, не сохраняется, в ворде похоже надо поменять параметры вставки.
Далее в проекте задумано одновременную добавку в буфер текста, дословно :""" (позиции тендера№ ххх) - предложены (выпадающий список фирм );"""". Список хочу сделать в виде базы данных в отдельном документе ексель.
всё это мной затеяно для автоматизации создания тендерного протокола, тока знаний не хватает....
_____________
С уважением.

[atamansha]

Здравствуйте! Извините, не разобралась, где создавать новую тему, поэтому пишу сюда.
Есть табличка в екселе с 3 столбцами: ФИО, должность, абривиатура отдела.
И есть вордовский документ, в котором мне нужно заменять данные о сотрудниках на данные из списка в екселе.
Написала макрос и все хорошо работает, но есть одна проблема: в екселе в столбце "Должность" во всех ячейках текст начинается с ЗАГЛАВНОЙ буквы, а вставлять его нужно с маленькой, но при этом должность может состоять из нескольких слов.
Подскажите, пожалуйста, решение для моей проблемы.

Вот часть кода по замене:
With Selection.Find
.Text = "Иванова Мария Ивановна"
.Replacement.Text = xlSht.Cells(i, 1)
' имя
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "ведущий технолог"
.Replacement.Text = xlSht.Cells(i, 2)
' должность
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "СВПС"
.Replacement.Text = xlSht.Cells(i, 3)
' отдел
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll

[rzrwolf]

А что нужно изменить в коде, чтобы получить в Worde отформатированную точно так же как в Excel таблицу? И как скорректировать её размеры автоматически при вставке?