Страницы: 1
RSS
Сохранить лист книги в отдельный файл.
 
Есть код

Код
Sub ПечатьPDF_выборочно()
    s = InputBox("Выбрать порядковый номер вкладки", "Печать листов", "1,2,4")
    If StrPtr(s) = 0 Or s = "" Then Exit Sub
    a = Split(s, ",")
    Filename = Application.GetSaveAsFilename(fileFilter:="Файлы PDF (*.pdf), *.pdf")
    sc = Sheets.Count
    Dim b() As String
    n = 0
    For i = 0 To UBound(a)
        If CInt(a(i)) <= sc Then
            ReDim Preserve b(0 To n)
            b(n) = Sheets(CInt(a(i))).Name
            n = n + 1
        End If
    Next
    Sheets(b).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
как его приспособить для сохранения выбранной (так же числом) вкладки в Excel...исходная книга защищена, листы тоже защищены.
 
Снять защиту
 
RAN,очень мудрый совет! но его не достаточно
 
А что достаточно? Один вопрос - одна тема. Что в этой теме обсуждать: снятие защиты? Сохранение листа? Защиту после сохранения?
 
vikttur, мне кажется я ясно дал понять, что прошу приспособить приведенный код под сохранение выбранного листа в excel...как снять и восстановить защиту я уж разберусь...просто решил не дробить, а сразу описать задачу целиком...
Изменено: vaspup88 - 28.12.2020 18:30:06
 
Название темы изменено
 
vaspup88, так не пробовали?
Код
Sub SaveSheets()
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:="C:\Имя файла.xlsx", _
            FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
 
Цитата
vaspup88 написал:
для сохранения выбранной (так же числом) вкладки
Михаил Витальевич С., это слишком просто...мне нужно как в моем вопросе в начале темы :)
Изменено: vaspup88 - 28.12.2020 19:02:28
 
Решение.
Код
Sub ПечатьExcel_выборочно()
    s = InputBox("Выбрать порядковый номер вкладки", "Печать листов", "1,2,4")
    If StrPtr(s) = 0 Or s = "" Then Exit Sub
    a = Split(s, ",")
    Filename = Application.GetSaveAsFilename(fileFilter:="Файлы Excel (*.xlsx), *.xlsx")
    sc = Sheets.Count
    Dim b() As String
    n = 0
    For i = 0 To UBound(a)
        If CInt(a(i)) <= sc Then
            ReDim Preserve b(0 To n)
            b(n) = Sheets(CInt(a(i))).Name
            n = n + 1
        End If
    Next
    Sheets(b).Copy
    ActiveWorkbook.SaveAs Filename
    ActiveWorkbook.Close
End Sub
 
skais675, спасибо, добрый человек! :)
Страницы: 1
Наверх