Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Печать по условию (макрос), Печать документа по условию: определенные листы и копии
 
#1
10.10.2022 16:06:20
Здравствуйте. Посоветуйте как подправить макрос. Имеется документ из более 100 листов с данными и оглавлением. В оглавлении указаны названия тех самых 100 листов, и столбец "кол-во печати". Нужно чтобы макрос проверил данный столбец и если в нем >0, то отправил тот лист на печать (напротив которого указана цифра) и столько копий, сколько указано. На данном форуме нашел нечто похожее, но там проверяется просто заполнена определённая ячейка или нет и печатает эти листы по 1 копии.
В предложенном примере он должен отпечатать листы:
"1" - 2 копии
"2" - 5 копий
"3" - 0 копий.

Заранее, спасибо за советы и помощь.
Код
Sub MyPrint()
Dim sh As Worksheet, s
With ThisWorkbook
For Each sh In .Worksheets
If Not sh.[AA1].Value = 0 Then s = s & sh.Name & ","
Next sh
s = Split(Left(s, Len(s) - 1), ",")
.Worksheets(s).PrintOut Copies:=1
End With
End Sub
 
 
 
#2
10.10.2022 16:27:24
Сергей Бригса, добрый день! Вариант:
Код
Sub MyPrint()
Dim sh As Range
Dim lr, shtName As String
With ThisWorkbook.Worksheets("Содержание")
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each sh In .Range("C2:C" & lr)
        shtName = Application.Evaluate(sh.Hyperlinks(1).SubAddress).Parent.Name
        Debug.Print sh.Offset(0, 1).Value
        If sh.Offset(0, 1).Value <> 0 Then Worksheets(shtName).PrintOut Copies:=sh.Offset(0, 1).Value
    Next sh
End With
End Sub
 
 
 
#3
10.10.2022 17:44:50
Цитата
написал:
Сергей Бригса , добрый день! Вариант:
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12      Sub   MyPrint()    Dim   sh   As   Range    Dim   lr, shtName   As   String    With   ThisWorkbook.Worksheets(  "Содержание"  )          lr = .Cells(.Rows.Count, 1).  End  (xlUp).Row          For   Each   sh   In   .Range(  "C2:C"   & lr)              shtName = Application.Evaluate(sh.Hyperlinks(1).SubAddress).Parent.Name              Debug.Print sh.Offset(0, 1).Value              If   sh.Offset(0, 1).Value <> 0   Then   Worksheets(shtName).PrintOut Copies:=sh.Offset(0, 1).Value          Next   sh    End   With    End   Sub  
 
Круто, все работает, но есть один момент. При печати в PDF (сохранении в PDF) он создает для каждого листа и каждой копии отдельный файл, следовательно при печати на принтер он также будет каждый "лист, копию" обрабатывать как вновь нажатую кнопку Печать. Можно ли как-то сделать, чтобы он все это создавал как одну единую печать (по другому: сохранял один единый PDF файл)?
К примеру, все в той же вышеупомянутой теме, с которой скачал первоначальный макрос первый код был
Код
Sub MyPrint()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If Not sh.[A1].Value = 0 Then sh.PrintOut Copies:=1
Next sh
End Sub

и он выдавал тоже столько файлов PDF сколько нужно было сделать копий.

А потом предложили код другой, который выдавал все в едином файле

Код
Sub MyPrint()
Dim sh As Worksheet, s
With ThisWorkbook
For Each sh In .Worksheets
If Not sh.[A1].Value = 0 Then s = s & sh.Name & ","
Next sh
s = Split(Left(s, Len(s) - 1), ",")
.Worksheets(s).PrintOut Copies:=1
End With
End Sub

 
 
 
#4
11.10.2022 08:18:33
Сергей Бригса, вариант с копированием областей печати на один лист с последующим сохранением в pdf.
   P.S. думаю, это единственный вариант в Вашем случае. Думаю, более опытные товарищи на этом форуме поправят меня, если я ошибаюсь. Спасибо!
Код
Sub MyPrint()
Dim sh As Range, wSh As Worksheet, copies_to_print As Integer, print_range As Range
Dim lr As Long, lrow As Long, shtName As String, j As Integer, saveLocation As String
If Not sheet_exists("print") Then
    Set wSh = ThisWorkbook.Worksheets.Add: wSh.Name = "print"
Else
    Set wSh = ThisWorkbook.Worksheets("print")
End If
With ThisWorkbook.Worksheets("Ñîäåðæàíèå")
    lrow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Each sh In .Range("C2:C" & lrow)
        shtName = Application.Evaluate(sh.Hyperlinks(1).SubAddress).Parent.Name
        Debug.Print Range(Worksheets(shtName).PageSetup.PrintArea).Address
        copies_to_print = sh.Offset(0, 1).Value
        For j = 1 To copies_to_print
            With Worksheets(shtName)
                lr = IIf(wSh.Cells(1, 1) = "", 1, .Range(.PageSetup.PrintArea).Rows.Count + lr)
                Worksheets(shtName).Range(Worksheets(shtName).PageSetup.PrintArea).Copy IIf(wSh.Cells(1, 1) <> "", wSh.Cells(lr + 1, 1), wSh.Cells(1, 1))
            End With
        Next j
        j = 1
    Next sh
End With
saveLocation = ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".pdf"
wSh.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation
Application.DisplayAlerts = 0
    wSh.Delete
Application.DisplayAlerts = 1
End Sub
Private Function sheet_exists(name_of_wsh As String) As Boolean
Dim sht As Worksheet
sheet_exists = True
On Error GoTo h
Set sht = Worksheets(name_of_wsh): Exit Function
h:
sheet_exists = False
End Function
Изменено: artemkau88 - 11.10.2022 08:47:16
 
 
 
#5
11.10.2022 14:13:09
можно делать предварительную печать - на виртуальном принтере
https://www.priprinter.com/
 
 
 
#6
11.10.2022 17:02:02
Всем спасибо. Собрав все предложенное, сделал как и хотел.
 
 
 
Страницы: 1
Наверх