Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Сохранение листа в pdf и открытие папки с ним
 
Знаю, коллеги, знаю, что миллион подобных тем. И вот из них и составлен код, который немного хочу подправить:
Код
Option Explicit

Private Sub Publish(ByVal FileName As String)
    Dim pBook As Workbook, pSheet As Worksheet
    Set pBook = Workbooks.Add(xlWBATWorksheet)
    Set pSheet = pBook.Worksheets(1)
    pSheet.Paste pSheet.Range("A1"), False
    'psheet.Pictures.
    With pSheet.PageSetup
        .PaperSize = xlPaperA4
        .Orientation = xlPortrait
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.196850393700787)
        .FooterMargin = Application.InchesToPoints(0.196850393700787)
    End With
    pSheet.ExportAsFixedFormat xlTypePDF, FileName, xlQualityStandard, False, False, OpenAfterPublish:=True
    pBook.Close False
End Sub

Public Sub ToPdfAsRaster()
    Dim firstRow As Long, lastRow As Long
    Dim firstCol As Long, lastCol As Long
    Dim pShape As Shape, pSheet As Worksheet
    Dim thisRange As Range, pdfName As String
    If TypeOf ActiveWorkbook.ActiveSheet Is Worksheet Then
        
        Set pSheet = ActiveWorkbook.ActiveSheet
        pdfName = Application.GetSaveAsFilename(pSheet.Name, "Acrobat PDF (*.pdf),*.pdf")
        If (UCase$(pdfName) = "FALSE") Or (UCase$(pdfName) = "ËÎÆÜ") Then Exit Sub
        ActiveWindow.DisplayGridlines = False
        Set thisRange = pSheet.UsedRange
        firstRow = thisRange.Row: lastRow = thisRange.Row + thisRange.Rows.Count - 1
        firstCol = thisRange.Column: lastCol = thisRange.Column + thisRange.Columns.Count - 1
        For Each pShape In pSheet.Shapes
            If pShape.TopLeftCell.Row < firstRow Then firstRow = pShape.TopLeftCell.Row
            If pShape.TopLeftCell.Column < firstCol Then firstCol = pShape.TopLeftCell.Column
            If pShape.BottomRightCell.Row > lastRow Then lastRow = pShape.BottomRightCell.Row
            If pShape.BottomRightCell.Column > lastCol Then lastCol = pShape.BottomRightCell.Column
        Next
        pSheet.Range(pSheet.Cells(firstRow, firstCol), pSheet.Cells(lastRow, lastCol)).CopyPicture xlScreen, xlBitmap
        Publish pdfName
    End If
End Sub

Необходимо чтобы:
1. Текущий лист сохранялся в pdf
2. После сохранения открывалась папка, в которой был сохранен pdf
3. (добавил) Буду сверщасилив если еще перед сохранением будет проверять - заполнены ли ячейки C2 и C5

Представленный код содержит излишний функционал, но боюсь самостоятельно справиться с очисткой я не сумел.

Спасибо!
Изменено: Ri Yu - 4 Дек 2018 22:40:33
чтоб дело мастера боялось, он знает много страшных слов.
 
Скрытый текст
Изменено: JayBhagavan - 5 Дек 2018 05:43:54

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
Страницы: 1
Читают тему (гостей: 1)
Наверх