Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выборочное сохранение листов в pdf - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборочное сохранение листов в pdf (Макросы/Sub)
Выборочное сохранение листов в pdf
graffserg Дата: Четверг, 13.10.2022, 14:16 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Всем привет! Кросс
Да, я знаю, что тема на форуме поднималась не первый десяток раз, но все же столкнулся вот с какими нюансами:
В копилке есть вот такой макрос:
[vba]
Код
Private Sub CommandButton1_Click()
Dim strFileName As String
s = Sheets("Данные").Range("N1").Value
a = Split(s, ",")
For i = 0 To UBound(a) 'начало цикла по массиву а с шагом по умолчанию 1
a(i) = Sheets(Val(a(i))).Name 'действия для каждой итерации цикла
Next 'переход на следующую итерацию циклаSheets(a).Select
Sheets(a).Select
    strFileName = "Бланк обмера " & Sheets("Данные").Range("L1").Value
    On Error Resume Next
    ChDir "\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub

Sub d()
    strFileName = "Бланк обмера " & Sheets("Данные").Range("L1").Value
    On Error Resume Next
    ChDir "\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub
[/vba]
, работа которого меня полностью устраивает но:
- после выполнения макроса листы отправленные в pdf остаются активными, т.е. выделенными.
- попытался присвоить имя из ячеек, находящихся на другом листе:
[vba]
Код
strFileName = "Бланк обмера " & Sheets("Бланк_обмера").Range("L1") & Sheets("Бланк_обмера").Range("V1") & Sheets("Бланк_обмера").Range("M2") & Sheets("Бланк_обмера").Range("W4").Value
[/vba]
макрос срабатывает, но файл не создается и соответственно его нельзя увидеть.
- pdf файл автоматически создается в папке, в которой находится исходный файл, а мне необходимо, чтобы созданные файлы помещались в определенную папку, например: Диск D - Смета - Обмеры.
Возможно ли данный макрос подправить с учетом изложенных выше предпочтений?
Спасибо.
 
Ответить
СообщениеВсем привет! Кросс
Да, я знаю, что тема на форуме поднималась не первый десяток раз, но все же столкнулся вот с какими нюансами:
В копилке есть вот такой макрос:
[vba]
Код
Private Sub CommandButton1_Click()
Dim strFileName As String
s = Sheets("Данные").Range("N1").Value
a = Split(s, ",")
For i = 0 To UBound(a) 'начало цикла по массиву а с шагом по умолчанию 1
a(i) = Sheets(Val(a(i))).Name 'действия для каждой итерации цикла
Next 'переход на следующую итерацию циклаSheets(a).Select
Sheets(a).Select
    strFileName = "Бланк обмера " & Sheets("Данные").Range("L1").Value
    On Error Resume Next
    ChDir "\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub

Sub d()
    strFileName = "Бланк обмера " & Sheets("Данные").Range("L1").Value
    On Error Resume Next
    ChDir "\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub
[/vba]
, работа которого меня полностью устраивает но:
- после выполнения макроса листы отправленные в pdf остаются активными, т.е. выделенными.
- попытался присвоить имя из ячеек, находящихся на другом листе:
[vba]
Код
strFileName = "Бланк обмера " & Sheets("Бланк_обмера").Range("L1") & Sheets("Бланк_обмера").Range("V1") & Sheets("Бланк_обмера").Range("M2") & Sheets("Бланк_обмера").Range("W4").Value
[/vba]
макрос срабатывает, но файл не создается и соответственно его нельзя увидеть.
- pdf файл автоматически создается в папке, в которой находится исходный файл, а мне необходимо, чтобы созданные файлы помещались в определенную папку, например: Диск D - Смета - Обмеры.
Возможно ли данный макрос подправить с учетом изложенных выше предпочтений?
Спасибо.

Автор - graffserg
Дата добавления - 13.10.2022 в 14:16
_Boroda_ Дата: Четверг, 13.10.2022, 14:24 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16510
Репутация: 6426 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
1. выделите один лист селектом
2. сцепили вы "Бланк обмера " с L1 V1 M2 и W4 и что получили в итоге?
3. замените ActiveWorkbook.Path на нужный путь


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение1. выделите один лист селектом
2. сцепили вы "Бланк обмера " с L1 V1 M2 и W4 и что получили в итоге?
3. замените ActiveWorkbook.Path на нужный путь

Автор - _Boroda_
Дата добавления - 13.10.2022 в 14:24
graffserg Дата: Четверг, 13.10.2022, 14:35 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
1. выделите один лист селектом

Это я знаю, вопрос в другом - как сделать, чтобы выделение листов автоматически снималось после выполнения макроса.

2. сцепили вы "Бланк обмера " с L1 V1 M2 и W4 и что получили в итоге?

Макрос срабатывает, но:
- pdf файл не создается.

3. замените ActiveWorkbook.Path на нужный путь

Попробую.
Спасибо.
 
Ответить
Сообщение
1. выделите один лист селектом

Это я знаю, вопрос в другом - как сделать, чтобы выделение листов автоматически снималось после выполнения макроса.

2. сцепили вы "Бланк обмера " с L1 V1 M2 и W4 и что получили в итоге?

Макрос срабатывает, но:
- pdf файл не создается.

3. замените ActiveWorkbook.Path на нужный путь

Попробую.
Спасибо.

Автор - graffserg
Дата добавления - 13.10.2022 в 14:35
_Boroda_ Дата: Четверг, 13.10.2022, 15:10 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16510
Репутация: 6426 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
1
как сделать, чтобы выделение листов автоматически снималось

Ну один-то должен остаться? Вот и выделите его в конце макроса. С остальных выделение снимется
2. Я разве про срабатывание макроса спрашивал? :D


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение1
как сделать, чтобы выделение листов автоматически снималось

Ну один-то должен остаться? Вот и выделите его в конце макроса. С остальных выделение снимется
2. Я разве про срабатывание макроса спрашивал? :D

Автор - _Boroda_
Дата добавления - 13.10.2022 в 15:10
graffserg Дата: Четверг, 13.10.2022, 15:50 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Вот, попробовал функцией:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ");" ";Бланк_обмера!L1;" ";Бланк_обмера!V1;" ";Бланк_обмера!M2)

сцепить название.
В макросе подправил строку:
[vba]
Код
strFileName = Sheets("Данные").Range("L1").Value
[/vba]
Нажимаю кнопку - появляется окно "Идет процесс публикации", потом перебрасывает на 1 лист книги excel и все на этом заканчивается.
Предполагаю, что это связано с длинной имени файла, т.к. оставляя в формуле:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ"))

Файл создается и имя ему присваивается в виде даты.


Сообщение отредактировал graffserg - Четверг, 13.10.2022, 15:51
 
Ответить
СообщениеВот, попробовал функцией:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ");" ";Бланк_обмера!L1;" ";Бланк_обмера!V1;" ";Бланк_обмера!M2)

сцепить название.
В макросе подправил строку:
[vba]
Код
strFileName = Sheets("Данные").Range("L1").Value
[/vba]
Нажимаю кнопку - появляется окно "Идет процесс публикации", потом перебрасывает на 1 лист книги excel и все на этом заканчивается.
Предполагаю, что это связано с длинной имени файла, т.к. оставляя в формуле:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ"))

Файл создается и имя ему присваивается в виде даты.

Автор - graffserg
Дата добавления - 13.10.2022 в 15:50
_Boroda_ Дата: Четверг, 13.10.2022, 16:11 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16510
Репутация: 6426 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Мда. Ответа на свой вопрос я так и не увидел. Ну ладно, как хотите


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеМда. Ответа на свой вопрос я так и не увидел. Ну ладно, как хотите

Автор - _Boroda_
Дата добавления - 13.10.2022 в 16:11
RAN Дата: Четверг, 13.10.2022, 16:14 | Сообщение № 7
Группа: Друзья
Ранг: Экселист
Сообщений: 5640
Репутация: 1145 ±
Замечаний: 0% ±

2010
Для вмнды Max Len(File.FullName) = 255 (ActiveWorkbook.Path & "\" & strFileName)
Для Excel ~ на 30 символов меньше. Точно не помню


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеДля вмнды Max Len(File.FullName) = 255 (ActiveWorkbook.Path & "\" & strFileName)
Для Excel ~ на 30 символов меньше. Точно не помню

Автор - RAN
Дата добавления - 13.10.2022 в 16:14
graffserg Дата: Четверг, 13.10.2022, 16:43 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
2. сцепили вы "Бланк обмера " с L1 V1 M2 и W4 и что получили в итоге?

Мда. Ответа на свой вопрос я так и не увидел. Ну ладно, как хотите

У меня один только ответ - НИЧЕГО в итоге я не получил из этой сцепки. Как ответить по-другому уме не приложу.

Интересен момент, опустошил всю книгу - и макрос начал работать. По всей видимости, что-то мешает макросу должным образом работать.
К сообщению приложен файл: 7048434.xlsm(56.1 Kb)
 
Ответить
Сообщение
2. сцепили вы "Бланк обмера " с L1 V1 M2 и W4 и что получили в итоге?

Мда. Ответа на свой вопрос я так и не увидел. Ну ладно, как хотите

У меня один только ответ - НИЧЕГО в итоге я не получил из этой сцепки. Как ответить по-другому уме не приложу.

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

Автор - graffserg
Дата добавления - 13.10.2022 в 16:43
_Boroda_ Дата: Четверг, 13.10.2022, 17:39 | Сообщение № 9
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16510
Репутация: 6426 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
По-моему, здесь только один вариант ответа. Вы получили в результате сцепления какой-то текст. Какой? Переменная strFileName чему равна?

Ладно, 18 часов, я до завтра убегаю. Может, еще кто подключится


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПо-моему, здесь только один вариант ответа. Вы получили в результате сцепления какой-то текст. Какой? Переменная strFileName чему равна?

Ладно, 18 часов, я до завтра убегаю. Может, еще кто подключится

Автор - _Boroda_
Дата добавления - 13.10.2022 в 17:39
graffserg Дата: Пятница, 14.10.2022, 00:01 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Вся загвоздка, на мой взгляд в этой строке макроса:
[vba]
Код
strFileName = "Бланк обмера " & Sheets("Данные").Range("L1").Value
[/vba]
Вот, если на рабочей книге в ячейке L1 присутствует дата, то макрос работает и сохраняет файл "Бланк обмера 02.09.2022.pdf".
Но как только в ячейку вставить формулу:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ");" ";Бланк_обмера!L1;" ";Бланк_обмера!V1;" ";Бланк_обмера!M2)
,
которая должна выводить название файла: "02.09.2022 пом. № 1 (этаж 1) г. Рога и копыта ул. Интересная д. 29.pdf", макрос не работает.

Но парадокс в том, что если листы книги очистить от содержимого и проделать те же манипуляции, как в первом случае - вставить формулу целиком, макрос работает исправно.
 
Ответить
СообщениеВся загвоздка, на мой взгляд в этой строке макроса:
[vba]
Код
strFileName = "Бланк обмера " & Sheets("Данные").Range("L1").Value
[/vba]
Вот, если на рабочей книге в ячейке L1 присутствует дата, то макрос работает и сохраняет файл "Бланк обмера 02.09.2022.pdf".
Но как только в ячейку вставить формулу:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ");" ";Бланк_обмера!L1;" ";Бланк_обмера!V1;" ";Бланк_обмера!M2)
,
которая должна выводить название файла: "02.09.2022 пом. № 1 (этаж 1) г. Рога и копыта ул. Интересная д. 29.pdf", макрос не работает.

Но парадокс в том, что если листы книги очистить от содержимого и проделать те же манипуляции, как в первом случае - вставить формулу целиком, макрос работает исправно.

Автор - graffserg
Дата добавления - 14.10.2022 в 00:01
Sancho Дата: Пятница, 14.10.2022, 15:24 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 279
Репутация: 19 ±
Замечаний: 0% ±

2007, 2010, 2013
graffserg, добрый день!
сдается мне вы не указали самое важное - расширение файла в строке
[vba]
Код
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
[/vba]
правильно скорее так:[vba]
Код
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
[/vba]

PS: ну и либо я обход ошибок бы выключил и смотрел конкретно что не так


Сообщение отредактировал Sancho - Пятница, 14.10.2022, 15:32
 
Ответить
Сообщениеgraffserg, добрый день!
сдается мне вы не указали самое важное - расширение файла в строке
[vba]
Код
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
[/vba]
правильно скорее так:[vba]
Код
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ActiveWorkbook.Path & "\" & strFileName & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
[/vba]

PS: ну и либо я обход ошибок бы выключил и смотрел конкретно что не так

Автор - Sancho
Дата добавления - 14.10.2022 в 15:24
graffserg Дата: Пятница, 14.10.2022, 20:53 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Добрый день!
сдается мне вы не указали самое важное - расширение файла в строке

Попробовал, но ничего не получается - результат тот же.
Буду продолжать раскопки.

И вот спустя несколько часов макрос переработал:
[vba]
Код
Sub Печать()
Dim CellValue As String
Dim Path As String
Dim FinalFileName As String
    Application.ScreenUpdating = False
    Path = "C:\Users\Admin\Desktop\" 'Путь сохранения файла
    'CellValue = Worksheets("Данные").Range("L1") '№ ячейки для присвоения имени
    SheetName = Worksheets("Данные").Range("L1").Value

    FinalFileName = Path & SheetName & ".pdf" 'Формируем итоговый путь и название файла
        'запоминаем имя выбранного листа - будем подставлять в путь для сохранения в PDF

    
    Sheets(Array("Бланк_обмера", "Стена_A", "Стена_B", "Стена_C", "Стена_D", "Потолок", "Пол", "Лист1")).Select
        'проверка - пуст лист или нет. Если пуст, то сообщаем
    If WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then
        MsgBox "Лист '" & SheetName & "' пуст! Невозможно его сохранить в PDF!", vbInformation, "Внимание"
        StartSheet.Select
        Exit Sub
    End If

    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    Application.ScreenUpdating = True
    MsgBox "Бланк обмера '" & SheetName & "' сохранён в PDF!", vbInformation, "Конец"
   
    Sheets("Бланк_обмера").Select
    
End Sub
[/vba]
Самое удивительное, что он работает - все собирает, сохраняет и так как я хочу, но:
1. Я до сих пор не могу добиться того, чтобы имя присваивалось с листа "Данные" ячейка L1, в которой находится все таже злополучная формула:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ");" ";Бланк_обмера!L1;" ";Бланк_обмера!V1;" ";Бланк_обмера!M2)

Я пробовал несколько вариантов, но результат:
[vba]
Код
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FinalFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
В этом случае выдает ошибку 1004.

[vba]
Код
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
[/code][/vba]
В этом случае появляется файл pdf, но его название - название файла Excel!!

[vba]
Код
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & SheetName  & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
В этом случае выдает ошибку 1004.

2. Еще одно но, но не особо существенное. Если к примеру выбран один лист и он пустой ( в моем случает "Лист1"), то макрос срабатывает на уведомление.
[vba]
Код
Sheets(Array("Бланк_обмера", "Стена_A", "Стена_B", "Стена_C", "Стена_D", "Потолок", "Пол", "Лист1")).Select
        'проверка - пуст лист или нет. Если пуст, то сообщаем
    If WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then
        MsgBox "Лист '" & SheetName & "' пуст! Невозможно его сохранить в PDF!", vbInformation, "Внимание"
[/vba].
А вот если выбрано несколько листов и среди них есть пустой лист, то макрос это уведомление пропускает.

Помогите разобраться и добить данный вопрос до конца.
Спасибо.


Сообщение отредактировал graffserg - Суббота, 15.10.2022, 00:43
 
Ответить
СообщениеДобрый день!
сдается мне вы не указали самое важное - расширение файла в строке

Попробовал, но ничего не получается - результат тот же.
Буду продолжать раскопки.

И вот спустя несколько часов макрос переработал:
[vba]
Код
Sub Печать()
Dim CellValue As String
Dim Path As String
Dim FinalFileName As String
    Application.ScreenUpdating = False
    Path = "C:\Users\Admin\Desktop\" 'Путь сохранения файла
    'CellValue = Worksheets("Данные").Range("L1") '№ ячейки для присвоения имени
    SheetName = Worksheets("Данные").Range("L1").Value

    FinalFileName = Path & SheetName & ".pdf" 'Формируем итоговый путь и название файла
        'запоминаем имя выбранного листа - будем подставлять в путь для сохранения в PDF

    
    Sheets(Array("Бланк_обмера", "Стена_A", "Стена_B", "Стена_C", "Стена_D", "Потолок", "Пол", "Лист1")).Select
        'проверка - пуст лист или нет. Если пуст, то сообщаем
    If WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then
        MsgBox "Лист '" & SheetName & "' пуст! Невозможно его сохранить в PDF!", vbInformation, "Внимание"
        StartSheet.Select
        Exit Sub
    End If

    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
    Application.ScreenUpdating = True
    MsgBox "Бланк обмера '" & SheetName & "' сохранён в PDF!", vbInformation, "Конец"
   
    Sheets("Бланк_обмера").Select
    
End Sub
[/vba]
Самое удивительное, что он работает - все собирает, сохраняет и так как я хочу, но:
1. Я до сих пор не могу добиться того, чтобы имя присваивалось с листа "Данные" ячейка L1, в которой находится все таже злополучная формула:
Код
=СЦЕПИТЬ(ТЕКСТ(Бланк_обмера!W4;"ДД.ММ.ГГГГ");" ";Бланк_обмера!L1;" ";Бланк_обмера!V1;" ";Бланк_обмера!M2)

Я пробовал несколько вариантов, но результат:
[vba]
Код
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FinalFileName, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
В этом случае выдает ошибку 1004.

[vba]
Код
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filename, Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
[/code][/vba]
В этом случае появляется файл pdf, но его название - название файла Excel!!

[vba]
Код
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & SheetName  & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
[/vba]
В этом случае выдает ошибку 1004.

2. Еще одно но, но не особо существенное. Если к примеру выбран один лист и он пустой ( в моем случает "Лист1"), то макрос срабатывает на уведомление.
[vba]
Код
Sheets(Array("Бланк_обмера", "Стена_A", "Стена_B", "Стена_C", "Стена_D", "Потолок", "Пол", "Лист1")).Select
        'проверка - пуст лист или нет. Если пуст, то сообщаем
    If WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then
        MsgBox "Лист '" & SheetName & "' пуст! Невозможно его сохранить в PDF!", vbInformation, "Внимание"
[/vba].
А вот если выбрано несколько листов и среди них есть пустой лист, то макрос это уведомление пропускает.

Помогите разобраться и добить данный вопрос до конца.
Спасибо.

Автор - graffserg
Дата добавления - 14.10.2022 в 20:53
graffserg Дата: Суббота, 15.10.2022, 20:33 | Сообщение № 13
Группа: Пользователи
Ранг: Участник
Сообщений: 84
Репутация: 1 ±
Замечаний: 0% ±

2010
Ура!!! Я нашел причину - ЗАПРЕЩЕННЫЕ ЗНАКИ в имени файла.
Вот итог:
[vba]
Код
Sub Печать()
Dim CellValue As String
Dim Path As String
Dim FinalFileName As String
    Application.ScreenUpdating = False
    Path = "C:\Users\Admin\Desktop\" 'Путь сохранения файла
    SheetName = Sheets("Данные").Range("L1").Value
    
    FinalFileName = Path & SheetName & ".pdf" 'Формируем итоговый путь и название файла
        'запоминаем имя выбранного листа - будем подставлять в путь для сохранения в PDF

    
    Sheets(Array("Бланк_обмера", "Стена_A", "Стена_B", "Стена_C", "Стена_D", "Потолок", "Пол")).Select
        'проверка - пуст лист или нет. Если пуст, то сообщаем
    If WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then
        MsgBox "Лист '" & SheetName & "' пуст! Невозможно его сохранить в PDF!", vbInformation, "Внимание"
        StartSheet.Select
        Exit Sub
    End If

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FinalFileName, Quality:= _
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   
    'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    'ActiveWorkbook.Path & "\" & "Бланк обмера '" & SheetName & ".pdf", Quality:= _
    'xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    'OpenAfterPublish:=True
        
    Application.ScreenUpdating = True
    MsgBox "Бланк обмера " & SheetName & " сохранён в PDF!", vbInformation, "Конец"

    Sheets("Бланк_обмера").Select
    
End Sub
[/vba]


Сообщение отредактировал graffserg - Суббота, 15.10.2022, 20:35
 
Ответить
СообщениеУра!!! Я нашел причину - ЗАПРЕЩЕННЫЕ ЗНАКИ в имени файла.
Вот итог:
[vba]
Код
Sub Печать()
Dim CellValue As String
Dim Path As String
Dim FinalFileName As String
    Application.ScreenUpdating = False
    Path = "C:\Users\Admin\Desktop\" 'Путь сохранения файла
    SheetName = Sheets("Данные").Range("L1").Value
    
    FinalFileName = Path & SheetName & ".pdf" 'Формируем итоговый путь и название файла
        'запоминаем имя выбранного листа - будем подставлять в путь для сохранения в PDF

    
    Sheets(Array("Бланк_обмера", "Стена_A", "Стена_B", "Стена_C", "Стена_D", "Потолок", "Пол")).Select
        'проверка - пуст лист или нет. Если пуст, то сообщаем
    If WorksheetFunction.CountA(ActiveSheet.Cells) = 0 Then
        MsgBox "Лист '" & SheetName & "' пуст! Невозможно его сохранить в PDF!", vbInformation, "Внимание"
        StartSheet.Select
        Exit Sub
    End If

     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FinalFileName, Quality:= _
     xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
   
    'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    'ActiveWorkbook.Path & "\" & "Бланк обмера '" & SheetName & ".pdf", Quality:= _
    'xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    'OpenAfterPublish:=True
        
    Application.ScreenUpdating = True
    MsgBox "Бланк обмера " & SheetName & " сохранён в PDF!", vbInformation, "Конец"

    Sheets("Бланк_обмера").Select
    
End Sub
[/vba]

Автор - graffserg
Дата добавления - 15.10.2022 в 20:33
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выборочное сохранение листов в pdf (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2022 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!