Макрос Excel. Необходимо последовательно вставлять номера приказов (подтягиваются нужные данные), выделить область печати и сохранить в Pdf

Question

Помогите пожалуйста!!! Споткнулась уже в самом конце....

Необходимо последовательно вставлять номера приказов (подтягиваются нужные данные), выделить область печати и сохранить в Pdf. Область печати выделяется корректно только если расположить приказы от большего количества строк к меньшему. Если после приказа с одной строкой идет приказ с строками, то область печати выделяет только одну, как в предыдущем.

Sub АвтЗаполнениеИСохранениеАктаПдФ()
  Dim wsПриказ As Worksheet, wsСвод As Worksheet
  Dim pdfFileName As String, lastRow As Long, значение As Variant, cell As Range
  ' Указываем листы
  Set wsПриказ = ThisWorkbook.Sheets("Приказ")
  Set wsСвод = ThisWorkbook.Sheets("Свод")
  ' Определить последнюю заполненную строку в столбце A на листе "Свод"
  lastRow = wsСвод.Cells(wsСвод.Rows.Count, "b").End(xlUp).Row
  ' Проверить, есть ли значения в столбце A
  If lastRow >= 2 Then
  ' Итерация по всем заполненным строкам столбца A (если нужно всего несколько приказов, измени диапазон и убери lastrow ("A556:A715" & lastRow)
    For Each cell In wsСвод.Range("b5:b8")
      ' Получить значение из ячейки столбца A
      значение = cell.Value
      ' Подставить значение в ячейку F2 на листе "Приказ"
      wsСвод.Range("F2").Value = значение
      ' Указываем лист
      Set ws = ThisWorkbook.Sheets("Приказ")
      ' Задаем область печати
      Dim sh As Worksheet
      Dim LstRw As Long, Rng As Range
      For Each sh In Sheets
        With sh
          LstRw = .Cells(.Rows.Count, "a").End(xlUp).Row
          Set Rng = .Range("A1:d" & LstRw)
          .PageSetup.PrintArea = Rng.Address
        End With
      Next sh
      ' Формируем имя файла PDF
      pdfFileName = ThisWorkbook.Path & "\" & wsСвод.Range("F2").Value & ".pdf"
      ' Сохраняем лист в формате PDF
      ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFileName, Quality:=xlQualityStandard
      ' Выводим сообщение об успешном сохранении
      'MsgBox "Лист 'Приказ' успешно сохранен в PDF: " & pdfFileName, vbInformation
      ' Имитируем нажатие клавиши "Enter" (Ок) для подтверждения сохранения
      Application.SendKeys "~"
      ' Пауза в  секунду
      Application.Wait Now + TimeValue("0:00:05")
    Next cell
  Else
    ' Если столбец A пуст, вывести сообщение
    MsgBox "Столбец A на листе 'Свод' пуст.", vbExclamation
  End If
End Sub

Answer 1

Судя по описанию из вопроса и комментариям, код должен выглядеть примерно так:

Sub АвтЗаполнениеИСохранениеАктаПдФ()
  Dim wsПриказ As Worksheet, wsСвод As Worksheet, inputs As Variant, i&
  Dim pdfFileName As String, lastRow As Long, значение As Variant
  ' Указываем листы
  Set wsПриказ = ThisWorkbook.Sheets("Приказ")
  Set wsСвод = ThisWorkbook.Sheets("Свод")
  ' Определить последнюю заполненную строку в столбце A на листе "Свод"
  With wsСвод
    lastRow = .[B1].End(xlDown).Row
    If lastRow < .Rows.Count Then
      inputs = Range(.[B2], .Cells(lastRow, "B"))
      ' Итерация по всем заполненным строкам столбца A (если нужно всего несколько приказов, измени диапазон и убери lastrow ("A556:A715" & lastRow)
      For i = 1 To UBound(inputs, 1)
        ' Получить значение из ячейки столбца A
        значение = inputs(i, 1)
        ' Подставить значение в ячейку F2 на листе "Свод"
        wsСвод.Range("F2").Value = значение
        ' Формируем имя файла PDF
        pdfFileName = ThisWorkbook.Path & "\" & значение & ".pdf"
        With wsПриказ
          ' Задаем область печати
          .PageSetup.PrintArea = Range(.[A1], .Cells.SpecialCells(xlCellTypeLastCell)).Address
          ' Сохраняем лист в формате PDF
          .ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFileName, Quality:=xlQualityStandard
        End With
        ' Выводим сообщение об успешном сохранении
        ' MsgBox "Лист 'Приказ' успешно сохранен в PDF: " & pdfFileName, vbInformation
        ' Имитируем нажатие клавиши "Enter" (Ок) для подтверждения сохранения
        Application.SendKeys "~"
        ' Пауза в  секунду
        Application.Wait Now + TimeValue("0:00:05")
      Next
    Else
      ' Если столбец A пуст, вывести сообщение
      MsgBox "Столбец A на листе 'Свод' пуст.", vbExclamation
    End If
  End With
End Sub

БЛОГ НА HUSL

Макрос Excel. Необходимо последовательно вставлять номера приказов (подтягиваются нужные данные), выделить область печати и сохранить в Pdf

Ответы (1 шт):