Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Из Excel в Word через Bookmarks, Оптимизация кода макроса
 
Добрый день, форумчане!

Подскажите, пожалуйста, как правильно описать копирование в Word из Excel через закладки? Код у меня (найден в интернете) работает, но смущает, что я что-то лишнее написал :(

Если что, текст будет копироваться из разных ячеек, листов, а также целые таблицы (пока код только на ячейки с определенного листа).
Код
Sub OpenDocument()
 
Dim wda As Word.Application
 
Set wda = CreateObject("Word.Application")
 
With wda
.Visible = True
.Documents.Open "U:\Documentik.docx"
.ActiveDocument.Bookmarks("Pervaya").Select
End With
 
Worksheets("qwerty").Activate
Range("B1").Copy
wda.Selection.PasteSpecial

With wda
.Visible = True
.Documents.Open "U:\Documentik.docx"
.ActiveDocument.Bookmarks("Vtoraya").Select
End With

Range("C1").Copy
wda.Selection.PasteSpecial
 
End Sub

 
Код не мой, но работает

Код
Sub CallDoc()
Call funOutputWord("" & ThisWorkbook.Path & "\temlate.dotx", "" & ThisWorkbook.Path & "\result.docx")

End Sub


'функция выгрузки в Word значений полей формы через закладки в шаблоне
Function funOutputWord(strPathDot As String, strPathWord As String) As Boolean
On Error GoTo Err_

Dim DlgUser As Integer, i As Long

    'проверяем наличие софрмированного ранее документа
    If Dir(strPathWord) <> "" Then 'если нашелся документ по заданому в strPathWord полному пути (вместе с именем)
        DlgUser = MsgBox("Документ с таким именем ранее уже был создан. Заменить его?", vbYesNo, "Внимание !!!")
        If DlgUser = vbNo Then 'если пользователь выбрал Нет - то открываем прежний вариант документа
            Set app = CreateObject("Word.Application") 'создаем объект Word, чтобы можно было работать с его методами и свойствами
            With app
                .Visible = True 'запускаем приложение Word
                .Documents.Open strPathWord 'открываем документ (по пути в переменной strPathWord)
            End With
            Set app = Nothing 'уничтожаем переменную
        Else 'если пользователь выбрал Да - то есть согласился перезаписать документ
            GoTo nn 'переходим по метке nn
        End If
    Else 'если не нашлось документа по заданому в strPathWord полному пути
nn:
        Set app = New Word.Application 'делаем ссылку на объект Word для создания нового документа
        app.Visible = True 'запускаем приложение Word
        app.Documents.Add strPathDot 'присоединяем к объекту Word шаблон по заданому пути
        With app.ActiveDocument 'делаем ссылку на активный документ - в данном случае тот что формируется
            'находим закладку по имени в заменяем ее на текст из поля формы
            
            'общая часть
            .Bookmarks.Item("bookmark_1").Range.Text = IIf(IsNull(Sheets(1).Cells(1, 1).Value), "", Sheets(1).Cells(1, 1).Value)
            .Bookmarks.Item("bookmark_2").Range.Text = IIf(IsNull(Sheets(1).Cells(1, 2).Value), "", Sheets(1).Cells(1, 2).Value)
            'и так далее. Если все букмарки назвать однотипно, то можно завернуть в цикл

            
            'если в шаблоне нужно заполнить таблицу - запускаем соответсвующую функцию
            'если заполнять таблицу не нужно - убираем эту строку
            'Call funOutputTableWordQuery(strPathDot, strPathWord)
            
            'Чистим незаполненные закладки
            With .Bookmarks
                For i = .Count To 1 Step -1
                    'если имя Bookmark совпадает с его содержимым
                    If .Item(i).Name = .Item(i).Range.Text Then
                        'Удаляем содержимое (вместе с ним удаляется и сама Bookmark)
                        .Item(i).Range.Text = ""
                    End If
                Next i
            End With

            .SaveAs strPathWord 'сохраняем созданный документ по заданному пути strPathWord
        End With
        Set app = Nothing 'уничтожаем переменную
    End If
    funOutputWord = True 'ставим флаг успешного выполнения функции
    
Exit_:
    Exit Function
Err_:
    funOutputWord = False
    Err.Clear
    app.Quit
    Resume Exit_
End Function
Изменено: panix1111 - 17 Июн 2017 10:40:05
Мы в Екселе не работаем, мы в нём живём!
 
panix1111,большое Вам спасибо! Попробую адаптировать под свой шаблон:)
 
Замечательный код, вот только у меня подтягивает из екселя значение созданное формулой, и у меня получается число с 8 знаками после запятой... Как мне изменить этот код для вставки форматированного текста ?
Код
 .Bookmarks.Item("bookmark_1").Range.Text = IIf(IsNull(Sheets(1).Cells(1, 1).Value), "", Sheets(1).Cells(1, 1).Value)
 
Дмитрий Князев, попробуйте заменить value на text.
P.S. только второе :)
Изменено: Hugo - 21 Мар 2018 16:51:56
 
Не получается, в екселе 4,494 в ворд вытянуло 449,4....

ПыСы Интересно именно форматирование, потому что и суммы выводит без нулей, а как целые числа. При чем не пойму логику, одни с нулями другие без ((
Изменено: Дмитрий Князев - 21 Мар 2018 17:07:41
 
Дмитрий Князев, придайте нужный формат с помощью функции ТЕКСТ на листе или Format в VBA.
Цитата
Дмитрий Князев написал:
IIf(IsNull(Sheets(1).Cells(1, 1).Value),...
Значение ячейки не может быть Null, так что это лишнее.
Страницы: 1
Читают тему (гостей: 1)