Печать через виртуальный принтер с автоматическим присвоением имени pdf файлу

[Starbirst]

Ребята! В листе ведомость имеется кнопка сохранения в pdf, эта функция исполнялась для Excel 2007. При открытии в Excel 2003 данная функция не работает. Можно ли сделать так, чтобы при печати через виртуальный принтер присваивалось уникальное имя файлу, которое прописано в макросе для Excel 2007? Спасибо!

[Surrogate]

в коде используется функция
ActiveSheet.ExportAsFixedFormat она повилась в офисе 2007 и в 2003 не работает естественно

[Surrogate]

придется поизобретать велосипед
в этой теме есть ссылка на исходник по переводу в pdf используя принтер BullZip

[Starbirst]

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

[Starbirst]

Я попробовал записать через макрорекордер, получил код:

Код: (vb)

Sub Макрос1()

    Application.ActivePrinter = "Adobe PDF (Ne02:)"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
        "Adobe PDF (Ne02:)", Collate:=True
End Sub

Как к полученному коду привязать строку FileName:="Ведомость дефектов " & Лист3.[C3] & " " & "зав. № " & Лист3.[C4] & " " & "рег. № " & Лист3.[C5] & " " & "(а" & Лист1.[D9] & ")"             ?
Простое добавление не помогает...

[Surrogate]

насколько я знаю метод ActiveWindow.SelectedSheets.PrintOut не позволяет сохранять файл с программно заданным именем, имя обязательно придется вбивать ручками.
или использовать BullZip - бесплатный виртуальный принтер, дело ваше
этот код у меня работает, но он всю простыню вывед на один лист

Код: (vb)

Sub zzz()
Dim fn As String
    fn = "D:\Ведомость дефектов " & Лист3.[C4] & " " & "зав. № " & Лист3.[C5] & " " & "рег. № " & Лист3.[C6] & " " & "(а" & Лист1.[D9] & ").pdf"
PrintSheetAsPDF fn
End Sub
Function PrintSheetAsPDF(file_name As String) ', merge_file_name As String)
    Dim obj_printer_util As Object
    Dim obj_printer_settings As Object
    Dim printername As String
    Set obj_printer_util = CreateObject("Bullzip.PDFUtil")
    printername = obj_printer_util.DefaultPrinterName
    Set obj_printer_settings = CreateObject("Bullzip.PDFSettings")
    obj_printer_settings.printername = obj_printer_util.DefaultPrinterName
    obj_printer_settings.LoadSettings (True)
    If file_name = "" Then Exit Function
    If LCase(Right(file_name, 4)) <> ".pdf" Then
        file_name = file_name & ".pdf"
    End If
    With obj_printer_settings
        .SetValue "output", save_path & file_name
        .SetValue "showsettings", "never"
        .SetValue "ConfirmOverwrite", "no" ' если файл с именем уже существует перезапишем без разговоров
        .SetValue "ShowPDF", "yes" ' после создания файла откроем его
        .SetValue "Target", "prepress"
        .SetValue "Author", Author ' не удалось избавиться от добавления своих персональных данных в файл 
        .SetValue "Title", doc_title
        .SetValue "Subject", subject_name
        .SetValue "Keywords", Keywords
        .SetValue "UseThumbs", "no"
        .SetValue "AutoRotatePages", "all"
        .SetValue "Linearize", "yes"
        .SetValue "Res", "3600"
               If FileType = "JPEG" Then
            .SetValue "Device", "jpeg"
        End If
        .WriteSettings True
    End With
    ActiveWorkbook.PrintOut visPrintAll
End Function

[Starbirst]

У меня не срабатывает данный код(

[Дмитрий Щербаков(The_Prist)]

У меня не срабатывает данный код(

А Bullzip установили хоть? Или только код пробуете? Когда говорят безликое "не работает", на такие утверждения всегда есть "а у меня работает". И так до бесконечности, пока Вы не расскажете в чем заключается "неработа" - где ошибка, текст ошибки, на какой строке?

[Starbirst]

Установил версию 9.8.1599.
При срабатывании макроса вылазит ошибка Run-Time error ' 1004'. Число должно находиться в интервале от 1 до 32767.
Предпоследняя строка (ActiveWorkbook.PrintOut visPrintAll) подсвечивается желтым цветом.

[Surrogate]

сорри

Код: (vb)

ActiveWorkbook.PrintOut

[Starbirst]

Срабатывает, но дважды выходит окно настройки и на печать выводится второй и третий лист.
Спасибо, конечно, большое, но по сути одно и то же получается, что через adobe, что через bullzip, нужно вручную имя pdf файла прописывать.
По сути у меня же имеется готовый код

Код: (vb)

Sub Макрос1()

    Application.ActivePrinter = "Adobe PDF (Ne02:)"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
        "Adobe PDF (Ne02:)", Collate:=True
End Sub

Комментарий глобального модератора

оформляйте код (кнопка на панели)

Как прописать, чтобы в диалоговом окне автоматом имя присваивалось "Ведомость дефектов " & Лист3.[C3] & " " & "зав. № " & Лист3.[C4] & " " & "рег. № " & Лист3.[C5] & " " & "(а" & Лист1.[D9] & ")"    

Спасибо!

[Starbirst]

Как прописать, чтобы в диалоговом окне автоматом имя присваивалось

Код: (vb)

"Ведомость дефектов " & Лист3.[C3] & " " & "зав. № " & Лист3.[C4] & " " & "рег. № " & Лист3.[C5] & " " & "(а" & Лист1.[D9] & ")"     

[Surrogate]

я данный код писал под работу с MS Visio, в Excel с листами я так и не понял что выводится на печать

Код: (vb)

"Ведомость дефектов " & Лист3.[C3] & " " & "зав. № " & Лист3.[C4] & " " & "рег. № " & Лист3.[C5] & " " & "(а" & Лист1.[D9] & ")"

я здесь не вижу ни папки ни расширения. в моем случае код сохраняет pdf куда надо

[Starbirst]

На печать выводится лист "Дефекты" и лист "Ведомость", причем именно в таком виде, как вы и писали - все на одном листе

[Starbirst]

Заменил строку

Код: (vb)

ActiveWorkbook.PrintOut  

на

Код: (vb)

ActiveSheet.PrintOut

все заработало нормально, но снова то же самое - имя файла по умолчанию - как название файла Excel, т. е. не присваивается, как прописано в коде. Что делать?