Преобразовать диапазона excel в PDF

@Alaskar · Регистрация: 15.06.2015

Студворк — интернет-сервис помощи студентам

Добрый день,
Мне нужна ваша помощь. Нашел в интернете макрос для преобразовать диапазон excel в PDF, но мне приходиться писать для каждого диапазона отдельный макрос.
Зарание скажу диапазонов гдето 150
Вопрос можноли упростить макрос ?
Зарание всем спасибо.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub PDF()
Filename$ = ThisWorkbook.Path & "" & Range("D9") & "_" & "TEST" & "_" & Range("AL9") & "_" & "SALARY" & ".pdf"
Dim vRetVal
On Error Resume Next
Set vRetVal = Range("A9:AK9")
If vRetVal Is Nothing Then
MsgBox "Zadaniye prervano", vbCritical, "Netu dannix"
Exit Sub
End If
vRetVal.ExportAsFixedFormat xlTypePDF, Filename$
PDF2
End Sub
Sub PDF2()
Filename$ = ThisWorkbook.Path & "" & Range("D10") & "_" & "TEST" & "_" & Range("AL10") & "_" & "SALARY" & ".pdf"
Dim vRetVal
On Error Resume Next
Set vRetVal = Range("A10:AK10")
If vRetVal Is Nothing Then
MsgBox "Zadaniye prervano", vbCritical, "Netu dannix"
Exit Sub
End If
vRetVal.ExportAsFixedFormat xlTypePDF, Filename$
PDF3
End Sub
Sub PDF3()
Filename$ = ThisWorkbook.Path & "" & Range("D11") & "_" & "TEST" & "_" & Range("AL11") & "_" & "SALARY" & ".pdf"
Dim vRetVal
On Error Resume Next
Set vRetVal = Range("A11:AK11")
If vRetVal Is Nothing Then
MsgBox "Zadaniye prervano", vbCritical, "Netu dannix"
Exit Sub
End If
vRetVal.ExportAsFixedFormat xlTypePDF, Filename$
PDF4
End Sub

@Prisioner · 27.01.2017, 16:22

Если оно у тебя всё настолько одинаково и идет подряд, то можно просто сделать цикл:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub PDF()
Dim first, last As Integer
first = 9 'Номер первого диапазона
last = 59 'Номер последнего диапазона
For i = first to last
Filename$ = ThisWorkbook.Path & "" & Range("D" & i) & "_" & "TEST" & "_" & Range("AL" & i) & "_" & "SALARY" & ".pdf"
Dim vRetVal
On Error Resume Next
Set vRetVal = Range("A" & i & ":AK" & i)
If vRetVal Is Nothing Then
MsgBox "Zadaniye prervano", vbCritical, "Netu dannix"
Exit Sub
End If
vRetVal.ExportAsFixedFormat xlTypePDF, Filename$
Next i
End Sub

Так же можно задавать номера первого и последнего диапазона значением определенных ячеек или вычислить исходя из "шаблона" вашего документа

@Alaskar · 28.01.2017, 08:14 **[ТС]**

Спасибо большое !

Добавлено через 15 часов 34 минуты
Еше раз здрасти.
А можно сделать так, чтобы он проверял если AK >0 тогда преобразует в пдф если нет то тогда пропускает стоку идет дальше ?

@pashulka · 28.01.2017, 10:39

Ещё один вариант

Visual Basic
1
2
3
4
5
6
7
Private Sub SaveToPDF()
    For iRow& = 0 To 149
        With Range("A9:AK9").Offset(iRow&)
             .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & .Item(1, 4) & "_TEST_" & .Item(1, 38) & "_SALARY.pdf"
        End With
    Next
End Sub

Тоже самое, но с доп.проверкой

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub SaveToPDF2()
    For iRow& = 0 To 149
        With Range("A9:AK9").Offset(iRow&)
             If Application.CountA(.Cells) > 0 Then
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & .Item(1, 4) & "_TEST_" & .Item(1, 38) & "_SALARY.pdf"
             Else
                Debug.Print "Не сохранено, ибо нет данных"
             End If
        End With
    Next
End Sub

@Alaskar · 28.01.2017, 13:20 **[ТС]**

Спасибо , Но не правильно работатет.
Мне нужно, чтобы проверял если Range("AK9") > 0 тогда Range("A9:AK9") в пдф а в противном слючае идет дальще

@Prisioner · 28.01.2017, 15:45

Если в столбце AK будет текст может выскочить ошибка выполнения, но в "грубом" виде проверка выглядит так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub PDF()
Dim first, last As Integer
first = 9 'Номер первого диапазона
last = 59 'Номер последнего диапазона
For i = first to last
if Range("AK"&i).Value > 0 then 
Filename$ = ThisWorkbook.Path & "" & Range("D" & i) & "_" & "TEST" & "_" & Range("AL" & i) & "_" & "SALARY" & ".pdf"
Dim vRetVal
On Error Resume Next
Set vRetVal = Range("A" & i & ":AK" & i)
If vRetVal Is Nothing Then
MsgBox "Zadaniye prervano", vbCritical, "Netu dannix"
Exit Sub
End If
vRetVal.ExportAsFixedFormat xlTypePDF, Filename$
End If
Next i
End Sub

@pashulka · 28.01.2017, 15:56

Вот так будет работать и с текстом и пр.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub SaveToPDF2()
    For iRow& = 0 To 149
        With Range("A9:AK9").Offset(iRow&)
             If Application.CountIf(.Item(1, 37), ">0") Then
                .ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & .Item(1, 4) & "_TEST_" & .Item(1, 38) & "_SALARY.pdf"
             Else
                Debug.Print "Не сохранено, ибо не >0"
             End If
        End With
    Next
End Sub

@Alaskar · 28.01.2017, 16:07 **[ТС]**

Spasibo vsem bolsoyeee

@pashulka · 28.01.2017, 17:04

Тоже самое, но в более привычной форме

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Private Sub SaveToPDF2v2()
    For iRow& = 9 To 158
        If Application.CountIf(Cells(iRow&, 37), ">0") Then
           Cells(iRow&, 1).Resize(, 37).ExportAsFixedFormat xlTypePDF, _
           ThisWorkbook.Path & "\" & Cells(iRow&, 4) & "_TEST_" & Cells(iRow&, 38) & "_SALARY.pdf"
           'Range("A1:AK1").Offset(iRow& - 1).ExportAsFixedFormat xlTypePDF, _
           ThisWorkbook.Path & "\" & Cells(iRow&, "D") & "_TEST_" & Cells(iRow&, "AL") & "_SALARY.pdf"
        Else
            Debug.Print "Не сохранено, ибо не >0"
        End If
    Next
End Sub

Новые блоги и статьи Все статьи Все блоги /
Программный отбор значения справочника Maks 21.03.2026 Процедура ВодителиНачалоВыбора(Элемент, ДанныеВыбора, ВыборДобавлением, СтандартнаяОбработка) / / Отключаем стандартную обработку (стандартное открытие формы выбора без фильтров) . . .	Переходник USB-CAN-GPIO Eddy_Em 20.03.2026 Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .	Оттенки серого Argus19 18.03.2026 Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .	SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip
Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .	[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ФедосеевПавел 14.03.2026 Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .	делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью	SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:

Преобразовать диапазона excel в PDF

Решение

Решение

Решение

@Alaskar 2 / 1 / 1 Регистрация: 15.06.2015 Сообщений: 8
	28.01.2017, 08:14 [ТС]
	Спасибо большое ! Добавлено через 15 часов 34 минуты Еше раз здрасти. А можно сделать так, чтобы он проверял если AK >0 тогда преобразует в пдф если нет то тогда пропускает стоку идет дальше ? 0

@Alaskar 2 / 1 / 1 Регистрация: 15.06.2015 Сообщений: 8
	28.01.2017, 13:20 [ТС]
	Спасибо , Но не правильно работатет. Мне нужно, чтобы проверял если Range("AK9") > 0 тогда Range("A9:AK9") в пдф а в противном слючае идет дальще 0

@Alaskar 2 / 1 / 1 Регистрация: 15.06.2015 Сообщений: 8
	28.01.2017, 16:07 [ТС]
	Spasibo vsem bolsoyeee 0