Сохранить как пдф с именем из ячейки

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Сохранить как пдф с именем из ячейки (Макросы/Sub)

Yar4i

Дата: Пятница, 26.02.2021, 13:13 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 137

Репутация: 1 ±

Замечаний: 0% ±

Excel 2010

Добрый день, дамы и господа

Помощи прошу в сохранении в пдф с именем файла из ячейки E6

Вот этот код пытался сам переработать, но первые 5 строк не знаю как отредактировать, что оставить...
[vba]

Код

A = Split([E6], "*")
For I = Len(A(3)) To 1 Step -1
If Mid$(A(3), I, 1) Like "[!- 0-9]" Then Exit For
Next
fn = "М 29 " & A(0) & ";" & "   " & A(1) & ";" & "   " & Trim$(Mid$(A(3), I + 1))    '  здесь от старого кода осталось, но удалять нужно лишнее
fn = Replace(fn, """", "")     'убираем несохраняемое
fn = Replace(fn, "/", ".")
fn = Replace(fn, "*", "х")
ActiveWorkbook.SaveAs "C:\000\" & [E6] & "*.pdf", FileFormat:=51   'сохраняем

[/vba]

В итоге пользуюсь творением Pelena, но приходится каждый раз имя прописывать
[vba]

Код

Sub pdf()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Application.GetSaveAsFilename(FileFilter:="файл PDF, *.pdf"), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'' закрыть Макрос
'Workbooks("макрос.xlsm").Close SaveChanges:=False
End Sub

[/vba]

К сообщению приложен файл: 9166213.xlsx (75.1 Kb)

Сообщение отредактировал Yar4i - Пятница, 26.02.2021, 13:14

Ответить

Pelena

Дата: Пятница, 26.02.2021, 14:04 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 19404

Репутация: 4555 ±

Замечаний: ±

Excel 365 & Mac Excel

Здравствуйте.
Если папку нужно, как и раньше, выбирать через диалоговое окно, то можно так. Имя будет уже введено в соответствующее поле
[vba]

Код

Sub pdf()
    Dim fn
    fn = Application.GetSaveAsFilename(InitialFileName:=Replace_symbols([E6]) & ".pdf", FileFilter:="файл PDF, *.pdf")
    If fn = False Then Exit Sub
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fn, Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

[/vba]
Здесь используется функция Replace_symbols, которая убирает из текста лишние символы
[vba]

Код

Function Replace_symbols(ByVal txt As String) As String
Dim st$, i&
    st = "/\~!@#$%^&*=|`';:?(),+"
    For i = 1 To Len(st$)
        txt = Replace(txt, Mid(st$, i, 1), "")
    Next
    Replace_symbols = txt
End Function

[/vba]
Если папка жёстко задана, просто пропишите параметр Filename примерно так:
[vba]

Код

Filename:="C:\000\" & Replace_symbols([E6])

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Сохранить как пдф с именем из ячейки (Макросы/Sub)

Страница 1 из 1
1