Vba excel сохранить документ word - Word и Excel - помощь в работе с программами

Создание нового документа Word или открытие существующего из кода VBA Excel. Методы Documents.Add и Documents.Open. Сохранение и закрытие документа.

Работа с Word из кода VBA Excel
Часть 2. Создание и открытие документов Word
[Часть 1] [Часть 2] [Часть 3] [Часть 4] [Часть 5] [Часть 6]

Новый документ Word создается из кода VBA Excel с помощью метода Documents.Add:

Sub Test1()

Dim myWord As New Word.Application

Dim myDocument As Word.Document

Set myDocument = myWord.Documents.Add

myWord.Visible = True

End Sub

Переменную myDocument можно объявить с типом Object, но тогда не будет ранней привязки к типу Word.Document и подсказок при написании кода (Auto List Members).

Открытие существующего документа

Существующий документ Word открывается из кода VBA Excel с помощью метода Documents.Open:

Sub Test2()

Dim myWord As New Word.Application

Dim myDocument As Word.Document

Set myDocument = _

myWord.Documents.Open(«C:Документ1.docx»)

myWord.Visible = True

End Sub

Замените в этой процедуре строку «C:Документ1.docx» на адрес своего файла.

Подключение к открытому документу

Присвоение переменной ссылки на существующий экземпляр Word.Application осуществляется в VBA Excel с помощью функции GetObject:

Sub Test3()

Dim myWord As Object, myDoc As Word.Document

On Error GoTo Instr

Set myWord = GetObject(, «Word.Application»)

Set myDoc = myWord.Documents(«Документ1.docx»)

myDoc.Range.InsertAfter «Добавляем новый текст, подтверждающий подключение к открытому документу.»

Exit Sub

Instr:

MsgBox «Произошла ошибка: « & Err.Description

End Sub

Если открытого приложения Word нет, выполнение функции GetObject приведет к ошибке. Также произойдет ошибка, если не будет найден указанный документ (в примере — «Документ1.docx»).

Сохранение и закрытие документа

Сохранение нового документа

Чтобы сохранить из кода VBA Excel новый документ Word, используйте метод SaveAs2 объекта Document:

myDocument.SaveAs2 («C:Документ2.docx»)

Замените «C:Документ2.docx» на путь к нужному каталогу с именем файла, под которым вы хотите сохранить новый документ.

Сохранение изменений в открытом документа

Сохраняйте изменения в существующем документе с помощью метода Document.Save или параметра SaveChanges метода Document.Close:

‘Сохранение изменений документа

myDocument.Save

‘Сохранение изменений документа

‘при закрытии

myDocument.Close ‘по умолчанию True

myDocument.Close True

myDocument.Close wdSaveChanges

‘Закрытие документа без

‘сохранения изменений

myDocument.Close False

myDocument.Close wdDoNotSaveChanges

Закрытие любого сохраненного документа

Метод Document.Close закрывает документ, но не приложение. Если работа с приложением закончена, оно закрывается с помощью метода Application.Quit.

Источник

Уважаемые форумчане, вынужден обратиться с вопросом следующего характера:
С Вашей же помощью мне удалось из кусочков составить код, который при запуске осуществляет копирование данных с листа Excelи вставляет эти данные на вновь созданный лист Word.

Но мне не удается реализовать заключительный этап своего замысла – мне необходимо вновь созданный файл Word предложить пользователю сохранить в исходной папке (папка где размещается файл Excel) с заготовкой имени файла. При этом команда на сохранение должна отдаваться именно пользователем, а не сохранятся автоматически.

Очень хочу реализовать свой замысел именно следующим образом:
1. Запуск макроса из книги Excel.
2. Копирование данных.
3. Создание листа Word.
4. Вставка данных на лист Word.
5. Вызов диалогового окна для сохранения файла с возможностью редактировать имя файла перед его сохранением. Путь сохранения (по умолчанию) должен быть предложен в папку, в которой сохранен Исходный файл Excel. – здесь мне требуется Ваша помощь!!!
6. После сохранения Пользователем файла завершение работы макроса.

Мне удалось найти решение этой задачи, но только в коде VBA для Word. Перечитал очень много тем, но так и не смог перевести данный код на понятный язык для Excel

Код
Sub MyFileSave() ' если запускать данный код из Word, то он полностью решает мою проблему Dim sPath As String sPath = ActiveDocument.Path & "" 'sPath = ActiveWorkbook.Path & "" ' для Excel, сэтимвродеудалосьразобраться With Dialogs(wdDialogFileSaveAs) ' а вот здесь при запуске макроса вылетает ошибка. .Name = sPath & "Переченьработ_" & Left(ActiveDocument.Paragraphs(2).Range.Text, Len(ActiveDocument.Paragraphs(2).Range.Text) - 1) .Show End With End Sub

Код

Sub MyFileSave() ' если запускать данный код из Word, то он полностью решает мою проблему
Dim sPath As String
 
sPath = ActiveDocument.Path & ""
'sPath = ActiveWorkbook.Path & "" ' для Excel, сэтимвродеудалосьразобраться
 
With Dialogs(wdDialogFileSaveAs) ' а вот здесь при запуске макроса вылетает ошибка.
.Name = sPath & "Переченьработ_" & Left(ActiveDocument.Paragraphs(2).Range.Text, Len(ActiveDocument.Paragraphs(2).Range.Text) - 1)
.Show
End With
End Sub

Очень прошу Вас помочь мне!
Спасибо!

Данная тема близка к моей проблеме

, но использовать под свои нужды не смог, так как в диалоговом окне не возможно выбрать расширение файла, а это мне тоже необходимо.

Пример прилагаю.

Источник

ASSEI

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

Excel

18.05.2020, 20:54. Показов 3865. Ответов 25

Метки нет (Все метки)

Ребята не пойму почему не сохраняется документ в папку:

Visual Basic

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim objWrdApp As Object
Dim objWrdDoc As Object
Dim F$
Dim iPath$
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
    On Error Resume Next
        If objWrdApp Is Nothing Then
            Set objWrdApp = CreateObject("Word.Application")
             Set objWrdDoc = objWrdApp.Documents.Open(App.Path & "МФО.docm")
            objWrdApp.Visible = True
With objWrdDoc
    .Bookmarks("полноеимяорг").Range.Text = CStr(Cells(Selection.Rows.Row, 12).Value)
End With
F$ = App.Path & "Вывод"
    objWrdDoc.SaveAs F$ & CStr(Cells(Selection.Rows.Row, 12).Value) & ".doc"
        objWrdApp.Quit
End If
End If
End Sub

2630 / 1636 / 744

Регистрация: 23.03.2015

Сообщений: 5,141

18.05.2020, 21:08

ASSEI,

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

Selection.Rows.Row

???

Модератор

11341 / 4660 / 748

Регистрация: 07.08.2010

Сообщений: 13,496

Записей в блоге: 4

18.05.2020, 21:19

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

On Error Resume Next

для начала закомменте эту строку — она не дает увидеть ошибки

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

18.05.2020, 21:20

[ТС]

да , вроде записывает

Модератор

11341 / 4660 / 748

Регистрация: 07.08.2010

Сообщений: 13,496

Записей в блоге: 4

18.05.2020, 21:23

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

Set objWrdDoc = objWrdApp.Documents.Open(App.Path & «МФО.docm»)

добавлять надо через шаблон ….. add(…..dotx/dotm)
открывая документ вы рискуете запороть документ, потеряв закладку

ASSEI

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

18.05.2020, 21:43

[ТС]

у меня ошибку выдает, когда закоментировал

Visual Basic

1	Set objWrdDoc = objWrdApp.Documents.Open(App.Path & "МФО.dotm")

Добавлено через 55 секунд
теперь вообще листа не видно открывается одно приложение

Добавлено через 12 минут
почему при открытии лист пропадает?

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

18.05.2020, 21:50

ASSEI, Если не обращать внимание на извращения, которые Вы упрямо копируете из темы в тему, то задайтесь вопросом, откуда в VBA может взяться App.Path ? ибо App это об’ект из «чистого» VB. А если документ находится в той же папке, что и книга, то ThisWorkbook.Path

ASSEI

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

18.05.2020, 22:30

[ТС]

согласен невнимателен, хотел пойти по пути наименьшего сопративления и просто как вы и сказали просто скопировать

Добавлено через 28 минут
вот как то так: или грубовато?

Visual Basic

1
2
3

F$ = ThisWorkbook.Path & "вывод"
    objWrdDoc.SaveAs F$ & CStr(Cells(Selection.Rows.Row, 13).Value) & ".doc"
        objWrdApp.Quit wdDoNotSaveChanges

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

18.05.2020, 22:52

Visual Basic

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("A:A"), Target) Is Nothing Then
       Dim wdApp As Object, wdDoc As Object, iPath$, txt$
       iPath = ThisWorkbook.Path
       Set wdApp = CreateObject("Word.Application")
       Set wdDoc = wdApp.Documents.Open(iPath & "МФО.docm") 'Или
       'Set wdDoc = wdApp.Documents.Add(iPath & "МФО.docm")
       wdApp.Visible = True: txt = CStr(Target(1, 12))
       wdDoc.Bookmarks("ПолноеИмяОрг").Range.Text = txt
       wdDoc.SaveAs iPath & "Вывод" & txt & ".doc", 0 'wdFormatDocument
       wdDoc.Close 0 'wdDocwdDoNotSaveChanges
       wdApp.Quit
    End If
End Sub

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

19.05.2020, 19:56

[ТС]

Ребята подскажите пожалуйста столкнулся с таким моментом что не каждую строку сохраняет в папку ? какие мысли по данному поводу? бывает где то на 500 тых не сохраняет а на 1000-х работает

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

19.05.2020, 19:59

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

что не каждую строку сохраняет в папку ?

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

If Target.Cells.Count > 1 Then Exit Sub

Что здесь удивительного, Вы сами ограничили выполнения макроса, сейчас только после выделения одной единственной ячейки.

Модератор

11341 / 4660 / 748

Регистрация: 07.08.2010

Сообщений: 13,496

Записей в блоге: 4

19.05.2020, 20:01

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

бывает где то на 500 тых не сохраняет а на 1000-х работает

в ворде может быть только 63 столбца, причем надо еще убирать 3,8мм полей
в ексель- тьма, до 16т столбцов

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

19.05.2020, 20:09

[ТС]

ага, не понял но еще поясню, на листе в таблице около 5000 строк,
1. поиском ищу нужное наименование
2. кликаю по ячейке, в столбце «А»,
2. Записываю в ворд найденую строку
3. и так много раз подряд

но получается что некоторые строки записываются в документ НО не сохраняется сам документ в папку т.е.
если закоментировать, строки в коде, сохранения в папку , то видно, что документ ворд формируется и записывается, НО приходится в ручную сохранять

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

19.05.2020, 20:15

[ТС]

посмотрите замысел во вложении, и таких строк в книге около 5000

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

19.05.2020, 20:15

ASSEI, И здесь тоже нет ничего удивительного, ведь имя файла не может содержать некоторые символы. А ячейка может, поэтому, перед сохранением нужно удалять мусор из имени файла.

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

19.05.2020, 20:45

[ТС]

так то все работает, но вот иногда такое бывает,
да вы правы такое то же может быть

Добавлено через 17 минут
посчитал 11300 т строк

Добавлено через 12 минут
ааа да кавычки не пропускает а у меня в файле их полно

Модератор

11341 / 4660 / 748

Регистрация: 07.08.2010

Сообщений: 13,496

Записей в блоге: 4

19.05.2020, 21:08

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

на листе в таблице около 5000 строк

это примерно 70 страниц — для ворда это много, не каждый комп потянет

Добавлено через 2 минуты

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

посчитал 11300 т строк

а это 11300/70=160страниц — тем более, особенно если автоподбор ширины столбцов(из личного опыта)

Добавлено через 2 минуты
выводила больше, но не таблицей, а гладким текстом, даже без табуляторов

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

19.05.2020, 21:28

shanemac51, Что ж Вас так перемкнуло на количестве строк, ведь видно, что одна строка = один документ. А проблема — именно в наличии недопустимых символах в имени файла.

ASSEI

0 / 1 / 3

Регистрация: 18.10.2012

Сообщений: 662

19.05.2020, 21:31

[ТС]

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

Добавлено через 12 минут
ааа да кавычки не пропускает а у меня в файле их полно

так я и отметил что да проблема именно в символах, но не получается, то пробелов лишних много

Visual Basic

1 2	Dim a As String a = Replace(CStr(Target(1, 13)), """", " ", "«»")

pashulka

4131 / 2235 / 940

Регистрация: 01.12.2010

Сообщений: 4,624

19.05.2020, 21:37

ASSEI, Имя файла это переменная txt, поэтому в строке #11

Visual Basic

1	wdDoc.SaveAs iPath & "Вывод" & newFileName(txt), 0 'wdFormatDocument

и, разумеется, функция, удаляющая весь мусор :

Visual Basic

Private Function newFileName$(oldFileName$)
    Const trash = "/?:*""""<>|"
    Dim i&
    For i = 1 To 10 'Len(trash)
        oldFileName = Replace(oldFileName, Mid$(trash, i, 1), "")
    Next
    newFileName = oldFileName & ".doc"
End Function

Источник

Автор lapin9126, 21 мая 2017, 08:33

Добрый день. Как сохранить открытый документ с другим именем, в другую папку расположенную в той же директории откуда открыт документ, и в нём выполнить макрос.
Например: документ с именем «Исходный» («С:оригиналы»), сохранить как «Исходный (копия)» в папку «обработано»(«С:оригиналыобработано») и в «Исходный (копия)» выполнить макрос.

Администратор

Administrator
Сообщения: 2,252
Записан

Исходный файл после создания копии нужно закрыть или нужно, чтобы он оставался открытым?

Администратор

Administrator
Сообщения: 2,252
Записан

Папка «обработано» должна быть создана (можно и с помощью макроса её создать).

Макрос

Sub Макрос()

Dim doc As Document

‘ Присваиваем активному ворд-файлу имя «doc».
Set doc = ActiveDocument

‘ Создание копии активного файла, при этом он закроется.
doc.SaveAs2 FileName:=doc.Path & «обработаноИсходный (копия).docx», FileFormat:=wdFormatXMLDocument

‘ Здесь делаете действия с переменной «doc», которая представляет собой новый созданный файл.
‘ Вывод имени файла «doc» в View — Immediate Window.
Debug.Print doc.Name

End Sub

[свернуть]

Администратор

Administrator
Сообщения: 2,252
Записан

Переменную «doc» не обязательно использовать, можно и без неё обойтись:

Макрос

Sub Макрос()
‘ Создание копии активного файла, при этом он закроется.
ActiveDocument.SaveAs2 FileName:=ActiveDocument.Path & «обработаноИсходный (копия).docx», FileFormat:=wdFormatXMLDocument
‘ Здесь делаете действия с новым созданным файлом, используя «ActiveDocument».
‘ Вывод имени активного файла в View — Immediate Window.
Debug.Print ActiveDocument.Name
End Sub

[свернуть]

При сохранении файла нужно присваивать имя исходного (открытого) файла с добавлением (копия), а не конкретно «Исходный (копия)» Это для примера было.

Администратор

Administrator
Сообщения: 2,252
Записан

Макрос

Sub Макрос()

Dim FN As String

‘1. Формирование полного имени (путь + имя) для нового файла на основе полного имени активного файла.
‘ Вычленение имени файла.
FN = Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, «.») — 1)
‘ Добавление к имени файла фразы «(копия»).
FN = FN & » (копия)» & «.docx»
‘ Добавление пути.
FN = ActiveDocument.Path & «» & FN

‘2. Создание копии активного файла, при этом он закроется.
ActiveDocument.SaveAs2 FileName:=FN, FileFormat:=wdFormatXMLDocument

‘3. Здесь делаете действия с новым созданным файлом, используя «ActiveDocument».
‘ Вывод имени активного файла в View — Immediate Window.
Debug.Print ActiveDocument.Name

End Sub

[свернуть]

Спасибо, чуть-чуть подправил (добавил место сохранения & «обработано» & «»), теперь то что нужно.

Форум по VBA, Excel и Word
►
Word
►
Макросы в Word
►
Word: Как сохранить документ (ворд-файл) с помощью VBA?

Источник

A couple quick things will get you to a solution.

The first is to loop through the worksheets in your workbook, like this:

Dim ws As Worksheet
For Each ws in ThisWorkbook.Sheets
    Debug.Print "The used range is " & ws.UsedRange.Address
Next ws

The next part is to understand how adding content to a Word document is accomplished. The main concept involves where the insertion point for the document is located — generally this is the current Selection.

When you cut and paste into a Word document, the content just pasted is still «selected». This means that any subsequent paste will effectively replace what you just inserted. So you have to move the selection point to the end of the document.

Putting it all together in an example program:

Option Explicit

Public Sub ExcelToWord()
    Dim wb As Workbook
    Set wb = ThisWorkbook

    '--- create the Word document
    Dim objWd As Word.Application
    Set objWd = CreateObject("word.application")
    objWd.Visible = True

    Dim objDoc As Word.Document
    Set objDoc = objWd.Documents.Add
    objDoc.PageSetup.Orientation = 1             '  portrait = 0

    Const wdPageBreak As Long = 7

    Dim ws As Worksheet
    For Each ws In wb.Sheets
        ws.UsedRange.Copy
        objWd.Selection.Paste
        '--- advance the selection point to the end of
        '    the document and insert a page break, then
        '    advance the insertion point past the break
        objDoc.Characters.Last.Select
        objWd.Selection.InsertBreak wdPageBreak
        objDoc.Characters.Last.Select
    Next ws
    'objDoc.SaveAs Application.ThisWorkbook.Path & ".dokument.docx"
End Sub

Источник