Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Помогите с макросом (копирование из Excel в Word)
 
Помогите пожалуйста чайнику с макросом, который мне необходим на работе, для заполнения бланков в Word путем копирования диапазона ячеек в Excel.
Уже весь форум облазил. Пробовал разные макросы и остановился на этом (ниже). Но в нем нет функции - "открыть уже созданный документ ворд и вставить скопированный диапазон в закладку, ну или пусть остается " в конце текста". Что не так?

Sub SelectionToDoc()
Dim objWord As Object
Const wdCollapseEnd = 0, wdCharacter = 1, wdNewBlankDocument = 0
' Найти открытое приложение Word (это может быть и Outlook, если в нем Word в качестве редактора)
On Error Resume Next
Set objWord = GetObject(, "Word.Application"  ;)  
' Если Word-приложение не найдено, то создать новое
If Err Then
' Нужна вот эта функция, но с ней не работает макрос
Set objWord = objWrdApp.Documents.Open("C:\1.doc"  ;)  
End If
objWord.Visible = True
' При ошибке - на выход! :-)
On Error GoTo exit_
' Если нет ни одного открытого Word-документа, то добавить новый
If objWord.Documents.Count = 0 Then objWord.Documents.Add
' Перейти в конец Word-документа
With objWord.ActiveDocument.Content
.Characters(.Characters.Count).Select
End With
' Добавть новый абзац в Word
objWord.Selection.TypeParagraph

' Cкопировать выделенный в Excel диапазон, вместо Selection можно указать и конкретный диапазон,
' например: Range("A3:B7"  ;)  .Copy
Range("B2:I14"  ;)  .Copy

' Вставить в Word
objWord.Selection.Paste

' Снять в Excel режим копирования
Application.CutCopyMode = False

' Активировать окно Microsoft Word (закомментировать строку ниже, если не нужно)
objWord.Tasks("Microsoft Word"  ;)  .Activate

exit_:

' Освободить память, использованную обхектной (As Object) переменной
Set objWord = Nothing

' Сообщить об ошибке, если случится
If Err Then MsgBox Err.Description, vbCritical, "Ошибка в макросе SelectionToDoc"

End Sub
 
А не проще ли использовать готовую надстройку?
http://excelvba.ru/programmes/FillDocuments

Одно нажатие кнопки - и все документы сформированы.
 
EducatedFool!
Надстройка - СУПЕР!!!
 
Зачем платить деньги, когда можно самому сделать, вот только нужен один толковый совет, как правильно написать код.
 
:D   :D   :D  
........
yurasmus!
Кесарю кесарево!  :D
 
У Вас там явно строчка пропущена:
Код
Set objWord = objWrdApp.CreateObject("Word.Application")


В этой статье я приводил пример кода обращения к Word: Как из Excel обратиться к другому приложению
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Куда ее вставлять? А по вашей статье, я побывал по разному, но выдает ошибку .
 
Цитата
yurasmus пишет: Куда ее вставлять?
Цитата
yurasmus пишет: вот только нужен один толковый совет
Все-таки ОДНИМ, видимо, не обойтись...
ps Может, если макросы далеки, взять более сподручным -  элементарным слиянием?.. Или денюжку копить... ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Цитата
yurasmus пишет:
Куда ее вставлять? А по вашей статье, я побывал по разному, но выдает ошибку .
А у меня по моей статье работает. Ошибку выдаст только если там поменять все. А приведенный Вами код неоходимо как раз менять для Вашей задачи.
Код
Sub SelectionToDoc()
    Dim objWord As Object, objWrdDoc As Object
    Const wdCollapseEnd As Long = 0, wdCharacter As Long = 1, wdNewBlankDocument As Long = 0
    ' Найти открытое приложение Word (это может быть и Outlook, если в нем Word в качестве редактора)
    On Error Resume Next
    'пытаемся подключится к объекту Word
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        'если приложение закрыто - создаем новый экземпляр
        Set objWrdApp = CreateObject("Word.Application")
        'делаем приложение видимым. По умолчанию открывается в скрытом режиме
        objWrdApp.Visible = True
    End If
    Set objWrdDoc = objWrdApp.Documents.Open("C:\Doc1.doc")
    ' Перейти в конец Word-документа
    With objWrdDoc.Content
        .Characters(.Characters.Count).Select
    End With
    ' Добавть новый абзац в Word
    objWord.Selection.TypeParagraph
    ' Cкопировать выделенный в Excel диапазон, вместо Selection можно указать и конкретный диапазон,
    ' например: Range("A3:B7").Copy
    Range("B2:I14").Copy
    ' Вставить в Word
    objWord.Selection.Paste
    ' Снять в Excel режим копирования
    Application.CutCopyMode = False
    ' Освободить память, использованную объектной (As Object) переменной
    Set objWord = Nothing
    ' Сообщить об ошибке, если случится
    If Err Then MsgBox Err.Description, vbCritical, "Ошибка в макросе SelectionToDoc"
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
В общем никак не получается.(((  Подскажите, что не так делаю, ведь уже поменял код и сделал по  статье The_Prist.  Поменял только диапазон ячеек, а вот в закладке где-то закралась ошибка.  В вордовском файле делал "закладка1".
Так же хотелось бы, чтобы таблица вставлялась по ширине вордовского листа, а не выползала за края - это возможно?

Помогите, пожалуйста, очень нужен этот макрос.
 
Приветствую!
Вопрос.
Из Excel в Word рисую "шапку".
Использую позднее связываение:

Dim oWord As Object, oDoc As Object

Set oWord = CreateObject("Word.Application" ;)
oWord.Visible = True
Set oDoc = oWord.Documents.Add()
oDoc.Activate

oWord.Selection.PageSetup.TopMargin = oWord.CentimetersToPoints(1.5)
   oWord.Selection.PageSetup.BottomMargin = oWord.CentimetersToPoints(1.5)
   oWord.Selection.PageSetup.LeftMargin = oWord.CentimetersToPoints(2.5)
   oWord.Selection.PageSetup.RightMargin = oWord.CentimetersToPoints(2)
   oWord.Selection.PageSetup.Gutter = oWord.CentimetersToPoints(0)
   oWord.Selection.Sections(1).Footers(1).PageNumbers.Add PageNumberAlignment:= _
 wdAlignPageNumberRight, FirstPage:=True

 With oWord.Selection
 .Font.Bold = True
 .ParagraphFormat.Alignment = wdAlignParagraphCenter
 .Font.Size = 11.5
 .TypeText Text:="Текст"
 .TypeParagraph
 .TypeText Text:="Текст"
 .TypeParagraph
 .TypeText Text:="Текст"
 .TypeParagraph
 .TypeParagraph
 .Font.Size = 11.5
 .ParagraphFormat.Alignment = wdAlignParagraphLeft
 .Font.Bold = wdToggle
 .Font.Color = wdColorBlack
 .Font.Underline = wdUnderlineSingle
 .TypeText Text:="Текст"
 .Font.Underline = wdUnderlineNone
 .TypeText Text:=vbTab & vbTab & vbTab & vbTab & vbTab
 .TypeParagraph
 .TypeParagraph
 .Font.Underline = wdUnderlineSingle
 .TypeText Text:="Текст"
 .Font.Underline = wdUnderlineNone
 .EndKey Unit:=wdLine
End With



Выравнивать по центру - wdAlignParagraphCenter не хочет.
ошибки не выдает.

на строчке   .EndKey Unit:=wdLine выдает ошибку


при включении библиотеки word через references (не меняя код) все работает.

Подскажите, где ошибка!
 
yurasmus, твой файл не открыл (у меня 2003)

А чё не воспользоваться слиянием Ворд и Ексель?. Супер!
Страницы: 1
Читают тему (гостей: 1)