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

Вход

Регистрация

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

 

= Мир MS Excel/Сохранить как пдф с именем из ячейки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранить как пдф с именем из ячейки (Макросы/Sub)
Сохранить как пдф с именем из ячейки
Yar4i Дата: Пятница, 26.02.2021, 13:13 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 137
Репутация: 1 ±
Замечаний: 0% ±

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

Помощи прошу в сохранении в пдф с именем файла из ячейки 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
 
Ответить
СообщениеДобрый день, дамы и господа :D

Помощи прошу в сохранении в пдф с именем файла из ячейки 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]

Автор - Yar4i
Дата добавления - 26.02.2021 в 13:13
Pelena Дата: Пятница, 26.02.2021, 14:04 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19176
Репутация: 4413 ±
Замечаний: ±

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
 
Ответить
СообщениеЗдравствуйте.
Если папку нужно, как и раньше, выбирать через диалоговое окно, то можно так. Имя будет уже введено в соответствующее поле
[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]

Автор - Pelena
Дата добавления - 26.02.2021 в 14:04
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранить как пдф с именем из ячейки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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