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

Вход

Регистрация

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

 

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

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

Excel 2010
Добрый день!
Прошу прощения, если пишу не в ту тему.
Существует макрос, который по нажатию кнопки сохраняет выделенную область в PDF файл. Нужно, чтобы при сохранении файла создавалась папка с аналогичным файлу именем. Буду благодарен (+ небольшой финансовой помощью), если сможете мне помочь. В ячейки D1 прописана директория сохранения файла, D2 - прописано название файла.
[vba]
Код

Sub Save()
With Application
.DisplayAlerts = False
With ActiveSheet
.PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:= _
.[D1] & .[D2], _
Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
.DisplayAlerts = True
End With
End Sub
[/vba]


Сообщение отредактировал Serge_007 - Суббота, 26.04.2014, 21:32
 
Ответить
СообщениеДобрый день!
Прошу прощения, если пишу не в ту тему.
Существует макрос, который по нажатию кнопки сохраняет выделенную область в PDF файл. Нужно, чтобы при сохранении файла создавалась папка с аналогичным файлу именем. Буду благодарен (+ небольшой финансовой помощью), если сможете мне помочь. В ячейки D1 прописана директория сохранения файла, D2 - прописано название файла.
[vba]
Код

Sub Save()
With Application
.DisplayAlerts = False
With ActiveSheet
.PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:= _
.[D1] & .[D2], _
Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
.DisplayAlerts = True
End With
End Sub
[/vba]
Автор - kovalrulit
Дата добавления - 26.04.2014 в 19:13
doober Дата: Суббота, 26.04.2014, 22:22 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Можно так
[vba]
Код
Sub Save()
     Dim F_Filename As String, Folder As String
     With Application
         .DisplayAlerts = False
         With ActiveSheet
             Set FSO = CreateObject("Scripting.FileSystemObject")
             F_Filename = Split(.[D2], ".")(0)
             Folder = .[D1] & F_Filename
             If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
             Set FSO = Nothing
             .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
             ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:= _
                    .[D1] & .[D2], _
                    Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
         End With
         .DisplayAlerts = True
     End With
End Sub
[/vba]

 
Ответить
СообщениеМожно так
[vba]
Код
Sub Save()
     Dim F_Filename As String, Folder As String
     With Application
         .DisplayAlerts = False
         With ActiveSheet
             Set FSO = CreateObject("Scripting.FileSystemObject")
             F_Filename = Split(.[D2], ".")(0)
             Folder = .[D1] & F_Filename
             If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
             Set FSO = Nothing
             .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
             ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                    Filename:= _
                    .[D1] & .[D2], _
                    Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False
         End With
         .DisplayAlerts = True
     End With
End Sub
[/vba]
Автор - doober
Дата добавления - 26.04.2014 в 22:22
kovalrulit Дата: Воскресенье, 27.04.2014, 00:03 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 20% ±

Excel 2010
doober, Большое спасибо, что помогли! Еще одно - можно ли поправить макрос, чтобы сохраняемый файл помещался в созданную папку. И напишите куда можно отправить вам благодарность $. Еще раз благодарю за помощь!
 
Ответить
Сообщениеdoober, Большое спасибо, что помогли! Еще одно - можно ли поправить макрос, чтобы сохраняемый файл помещался в созданную папку. И напишите куда можно отправить вам благодарность $. Еще раз благодарю за помощь!
Автор - kovalrulit
Дата добавления - 27.04.2014 в 00:03
doober Дата: Воскресенье, 27.04.2014, 10:46 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub Save()
     Dim F_Filename As String, Folder As String
     With Application
         .DisplayAlerts = False
         With ActiveSheet
             Set FSO = CreateObject("Scripting.FileSystemObject")
             F_Filename = Split(.[D2], ".")(0)
             Folder = .[D1] & F_Filename
             If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
             Set FSO = Nothing
             .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
             ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                     Filename:= _
                  Folder & "\" & .[D2], _
                     Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False
         End With
         .DisplayAlerts = True
     End With
End Sub
[/vba]

 
Ответить
Сообщение[vba]
Код
Sub Save()
     Dim F_Filename As String, Folder As String
     With Application
         .DisplayAlerts = False
         With ActiveSheet
             Set FSO = CreateObject("Scripting.FileSystemObject")
             F_Filename = Split(.[D2], ".")(0)
             Folder = .[D1] & F_Filename
             If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
             Set FSO = Nothing
             .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
             ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                     Filename:= _
                  Folder & "\" & .[D2], _
                     Quality:=xlQualityHigh, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                     OpenAfterPublish:=False
         End With
         .DisplayAlerts = True
     End With
End Sub
[/vba]
Автор - doober
Дата добавления - 27.04.2014 в 10:46
Korobkow Дата: Понедельник, 22.09.2014, 21:54 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброго дня знатоки!
А если тоже самое, но только не PDF, а просто XLS, без экспорта файла и директория сохранения - рабочий стол? Спасибо-хоть и не шуршит, но от чистого сердца.

Цитата doober, 27.04.2014 в 10:46, в сообщении № 4
If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
            Set FSO = Nothing
            .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
 
Ответить
СообщениеДоброго дня знатоки!
А если тоже самое, но только не PDF, а просто XLS, без экспорта файла и директория сохранения - рабочий стол? Спасибо-хоть и не шуршит, но от чистого сердца.

Цитата doober, 27.04.2014 в 10:46, в сообщении № 4
If Not FSO.FolderExists(Folder) Then FSO.CreateFolder Folder
            Set FSO = Nothing
            .PageSetup.PrintArea = Application.InputBox("Выделите область печати", Default:="$A$1:$C$26", Type:=2)
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Автор - Korobkow
Дата добавления - 22.09.2014 в 21:54
Pelena Дата: Понедельник, 22.09.2014, 22:01 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
Korobkow, прочитайте Правила форума и создайте свою тему. Эта тема закрыта

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеKorobkow, прочитайте Правила форума и создайте свою тему. Эта тема закрыта
Автор - Pelena
Дата добавления - 22.09.2014 в 22:01
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сохранение PDF с созданием папки под именем ячейки. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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