Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сохранение листов excel в pdf-формате - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение листов excel в pdf-формате (Макросы/Sub)
Сохранение листов excel в pdf-формате
Артемпилот Дата: Суббота, 24.08.2019, 19:16 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день! Есть задача сохранить каждый лист из книги Excel в отдельных файл pdf. Написал макрос, отдельные pdf-файлы сохраняются на компе, но после сохранения не открываются. Пишет, что файл не поддерживается или был поврежден. Помогите, пожалуйста, понять, в чем проблема. Excel 2019

[vba]
Код
Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
Optional ByVal InitialPath As String = "C:\Users\Ivanov\Documents\Russia") As String

Dim PS As String: PS = Application.PathSeparator
With Application.FileDialog(msoFileDialogFolderPicker)
If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show <> -1 Then Exit Function
GetFolderPath = .SelectedItems(1)
If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
End With
End Function

Sub PrintOut_v4()

Dim s As Double
Dim i As Double

Dim MyPath
MyPath = GetFolderPath

s = ThisWorkbook.Sheets.Count

For i = 1 To s

Sheets(i).Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""[/c]
ActiveSheet.PrintOut , printtofile:=True, prtofilename:=MyPath & ActiveSheet.Name & ".pdf"
End With
Application.ScreenUpdating = False
Next i

End Sub
[/vba]


Сообщение отредактировал Артемпилот - Суббота, 24.08.2019, 20:14
 
Ответить
СообщениеДобрый день! Есть задача сохранить каждый лист из книги Excel в отдельных файл pdf. Написал макрос, отдельные pdf-файлы сохраняются на компе, но после сохранения не открываются. Пишет, что файл не поддерживается или был поврежден. Помогите, пожалуйста, понять, в чем проблема. Excel 2019

[vba]
Код
Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
Optional ByVal InitialPath As String = "C:\Users\Ivanov\Documents\Russia") As String

Dim PS As String: PS = Application.PathSeparator
With Application.FileDialog(msoFileDialogFolderPicker)
If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
If .Show <> -1 Then Exit Function
GetFolderPath = .SelectedItems(1)
If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
End With
End Function

Sub PrintOut_v4()

Dim s As Double
Dim i As Double

Dim MyPath
MyPath = GetFolderPath

s = ThisWorkbook.Sheets.Count

For i = 1 To s

Sheets(i).Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""[/c]
ActiveSheet.PrintOut , printtofile:=True, prtofilename:=MyPath & ActiveSheet.Name & ".pdf"
End With
Application.ScreenUpdating = False
Next i

End Sub
[/vba]

Автор - Артемпилот
Дата добавления - 24.08.2019 в 19:16
Pelena Дата: Суббота, 24.08.2019, 19:36 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 14473
Репутация: 3172 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Артемпилот, оформите коды тегами с помощью кнопки # в режиме правки поста


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеАртемпилот, оформите коды тегами с помощью кнопки # в режиме правки поста

Автор - Pelena
Дата добавления - 24.08.2019 в 19:36
Артемпилот Дата: Суббота, 24.08.2019, 20:03 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Простите, я не очень понял, каким образом нужно выделить коды
 
Ответить
СообщениеПростите, я не очень понял, каким образом нужно выделить коды

Автор - Артемпилот
Дата добавления - 24.08.2019 в 20:03
Pelena Дата: Суббота, 24.08.2019, 20:09 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 14473
Репутация: 3172 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Внизу своего поста нажмите кнопку Правка, выделите код и нажмите кнопку # на панели инструментов, потом сохраните пост


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеВнизу своего поста нажмите кнопку Правка, выделите код и нажмите кнопку # на панели инструментов, потом сохраните пост

Автор - Pelena
Дата добавления - 24.08.2019 в 20:09
Артемпилот Дата: Суббота, 24.08.2019, 20:14 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Спасибо, сделано
 
Ответить
СообщениеСпасибо, сделано

Автор - Артемпилот
Дата добавления - 24.08.2019 в 20:14
Pelena Дата: Суббота, 24.08.2019, 20:40 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 14473
Репутация: 3172 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
По теме: попробуйте вместо строки
[vba]
Код
ActiveSheet.PrintOut , printtofile:=True, prtofilename:=MyPath & ActiveSheet.Name & ".pdf"
[/vba]
написать
[vba]
Код
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyPath & ActiveSheet.Name, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
И ещё - макрос будет выполняться быстрее, если строки
[vba]
Код
        Sheets(i).Select
        With ActiveSheet.PageSetup
[/vba]
заменить на
[vba]
Код
        With Sheets(i).PageSetup
[/vba]
и все дальнейшие ActiveSheet заменить на Sheets(i)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеПо теме: попробуйте вместо строки
[vba]
Код
ActiveSheet.PrintOut , printtofile:=True, prtofilename:=MyPath & ActiveSheet.Name & ".pdf"
[/vba]
написать
[vba]
Код
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyPath & ActiveSheet.Name, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
И ещё - макрос будет выполняться быстрее, если строки
[vba]
Код
        Sheets(i).Select
        With ActiveSheet.PageSetup
[/vba]
заменить на
[vba]
Код
        With Sheets(i).PageSetup
[/vba]
и все дальнейшие ActiveSheet заменить на Sheets(i)

Автор - Pelena
Дата добавления - 24.08.2019 в 20:40
Артемпилот Дата: Суббота, 24.08.2019, 21:29 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Сработало, большое спасибо!)
 
Ответить
СообщениеСработало, большое спасибо!)

Автор - Артемпилот
Дата добавления - 24.08.2019 в 21:29
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение листов excel в pdf-формате (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!