Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как сохранить копию листа Excel в Word?
 
#1
07.11.2017 15:31:36
Всем привет.

Вот фрагмент кода , где копия листа схраняется в формате Pdf.
Код
Sheets("Рапорт").Select

pathS = "\\192.168.64.33\Quality\10-ТЕСТЫ ПРОИЗВОДСТВО\Архив рапортов\"

    Application.ScreenUpdating = False
 
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
     pathS & "" & Year(Date) & "-" & Month(Date) & _
    
 "-" & Day(Date) & "  " & Hour(Time) & "." & 
Minute(Time) & "   Бригада   " & Range("F5") & "-" & 
Range("F6") & ".PDF", Quality:= _
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
    Application.ScreenUpdating = True

Но так как на компьютере, где выполняется макрос установлен Excel 2003, эта операция невозможна.
Помогите пожалуйста переделать код, чтобы лист сохранялся в Worde.
Изменено: Vova67 - 07.11.2017 15:36:00
 
 
 
#2
07.11.2017 15:58:36
Сохранять в Word не так-то просто. Для этого надо сначала подключиться к самому Word. Далее надо будет вставить все данные листа. А потом самое сложное - отформатировать так, чтобы это вменяемо выглядело. Попробуйте просто скопировать всю необходимую инф-цию с листа Excel и вставить её на чистый лист Word. Если результат устроит - постараюсь накидать код.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
07.11.2017 16:06:53
Цитата
The_Prist написал:
Попробуйте просто скопировать всю необходимую инф-цию с листа Excel и вставить её на чистый лист Word. Если результат устроит - постараюсь накидать код.
Сделал как вы сказали. Результат полностью устроил.
Скопировал полностью лист Excel и вставил в Word
Изменено: Vova67 - 07.11.2017 16:10:51
 
 
 
#4
07.11.2017 18:06:39
Пробуйте:
Код
Sub SaveRangeToWord()
    Dim objWrdApp As Object, objWrdDoc As Object
    Dim pathS As String, IsAppClose As Boolean
    
    Application.ScreenUpdating = False
    
    'пытаемся подключится к Word
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
        IsAppClose = True
        'если надо сделать видимым - раскомментировать
        'objWrdApp.Visible = True
    End If
    On Error GoTo 0
    If objWrdApp Is Nothing Then
        MsgBox "Не удалось подключиться к Word"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    Set objWrdDoc = objWrdApp.Documents.Add

    pathS = "\\192.168.64.33\Quality\10-ТЕСТЫ ПРОИЗВОДСТВО\Архив рапортов\"
    objWrdDoc.SaveAs pathS & Year(Date) & "-" & Month(Date) & _
                "-" & Day(Date) & "  " & Hour(Time) & "." & _
                Minute(Time) & "   Бригада   " & Range("F5") & "-" & _
                Range("F6") & ".doc"
    
    Sheets("Рапорт").UsedRange.Copy
    'вставляем скопированные ячейки в Word - в начала документа
    objWrdDoc.Range(0).Paste

    objWrdDoc.Close False
    If IsAppClose Then
        objWrdApp.Quit
    End If
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
    Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
07.11.2017 19:39:43
А если попробовать печать на виртуальный принтер типа doPDF?
 
 
 
#6
07.11.2017 21:16:56
К сожалению такой вариант не подходит, лист "Рапорт" должен распечатываться и сохраняться его копия в один клик. Таковы условия на производстве...

The_Prist, вставил Ваш код, создается вордовский файл, с нужным именем, но пустой...
 
 
 
#7
08.11.2017 02:31:45
The_Prist, Простите Дмитрий, у вас в 34ой строчке не опечатка ?
Код
objWrdDoc.Close False
Наверное, всё же, так должно быть.:)
Код
objWrdDoc.Close True
Изменено: Александр П. - 08.11.2017 02:36:44
 
 
 
#8
08.11.2017 10:45:14
Александр П.- в точку! Все работает!

Спасибо The_Prist, спасибо Александр П.!
 
 
 
#9
08.11.2017 11:09:19
Эх, еще маленький нюанс.Не сохраняется диаграмма . Но если это сложно, то и фиг с ней.
И так сойдет(с)
 
 
 
#10
08.11.2017 20:41:54
Цитата
Александр П. написал:
у вас в 34ой строчке не опечатка ?
Нет, надо было просто строки местами поменять, что я забыл сделать :)
Код
Sub SaveRangeToWord()
    Dim objWrdApp As Object, objWrdDoc As Object
    Dim pathS As String, IsAppClose As Boolean
     
    Application.ScreenUpdating = False
     
    'пытаемся подключится к Word
    On Error Resume Next
    Set objWrdApp = GetObject(, "Word.Application")
    If objWrdApp Is Nothing Then
        Set objWrdApp = CreateObject("Word.Application")
        IsAppClose = True
        'если надо сделать видимым - раскомментировать
        'objWrdApp.Visible = True
    End If
    On Error GoTo 0
    If objWrdApp Is Nothing Then
        MsgBox "Не удалось подключиться к Word"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    Set objWrdDoc = objWrdApp.Documents.Add

    Sheets("Рапорт").UsedRange.Copy
    'вставляем скопированные ячейки в Word - в начала документа
    objWrdDoc.Range(0).Paste
    pathS = "\\192.168.64.33\Quality\10-ТЕСТЫ ПРОИЗВОДСТВО\Архив рапортов\"
    objWrdDoc.SaveAs pathS & Year(Date) & "-" & Month(Date) & _
                "-" & Day(Date) & "  " & Hour(Time) & "." & _
                Minute(Time) & "   Бригада   " & Range("F5") & "-" & _
                Range("F6") & ".doc"
 
    objWrdDoc.Close False
    If IsAppClose Then
        objWrdApp.Quit
    End If
    Set objWrdDoc = Nothing: Set objWrdApp = Nothing
    Application.ScreenUpdating = True
End Sub

Цитата
Vova67 написал:
Не сохраняется диаграмма
Не знаю что там не сохраняется и где именно эта диаграмма. Как вариант можно попробовать в обязательном порядке в крайней нижней правой ячейке от  диаграммы поставить пробел и после этого выполнять макрос. Возможно, диаграмма полностью не попадает в рабочую область и именно поэтому не копируется. Но объекты при методе Copy с листа Excel могут не попадать в буфер обмена (наблюдал такое поведение на некоторых версиях).
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#11
09.11.2017 10:32:12
Цитата
The_Prist написал:
Возможно, диаграмма полностью не попадает в рабочую область и именно поэтому не копируется.
Да, именно эта причина. Немного поигрался местоположением диаграммы и все стало хорошо. Большое вам спасибо.

И пробел тоже помог...
Изменено: Vova67 - 09.11.2017 11:10:18
 
 
 
#12
22.01.2021 13:50:52
Цитата
The_Prist написал:
Нет, надо было просто строки местами поменять, что я забыл сделать Код
Добрый день!
При попытке использовать ваш код выгружается растянутая таблица без колонтитула.
Можете подсказать, как сделать так, чтобы выгрузить лист целиком в Word, включая колонтитулы?  
Изменено: Olzhas - 03.03.2021 12:34:22
 
 
 
#13
22.01.2021 14:12:34
Цитата
Olzhas написал:
включая колонтитулы?  
файл не смотрел, но колонтитулы вообще отдельная тема и их так же отдельно надо переносить. Копировать не получится. Не самая простая тема.
Ну а про это
Цитата
Olzhas написал:
выгружается растянутая таблица

я писал в самом начале темы:
Цитата
The_Prist написал:
А потом самое сложное - отформатировать так, чтобы это вменяемо выглядело.
после переноса надо все подгонять под нужный Вам формат. Тоже не самое мое любимое занятие. Это надо делать уже в Word. Перенесите туда таблицу как есть и попробуйте отформатировать до нужного состояния руками. Если это будет просто(типа просто ужали её с краев) - значит вполне легко можно это записать макрорекордером ворда и подставить в код из Excel. А если там куча подстроек под размер - это уже совершенно отдельная тема и тоже не самая простая, возможно.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
Страницы: 1
Наверх