Добрый день! Прошу прощения, если пишу не в ту тему. Существует макрос, который по нажатию кнопки сохраняет выделенную область в 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]
Добрый день! Прошу прощения, если пишу не в ту тему. Существует макрос, который по нажатию кнопки сохраняет выделенную область в 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
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
doober, Большое спасибо, что помогли! Еще одно - можно ли поправить макрос, чтобы сохраняемый файл помещался в созданную папку. И напишите куда можно отправить вам благодарность $. Еще раз благодарю за помощь!
doober, Большое спасибо, что помогли! Еще одно - можно ли поправить макрос, чтобы сохраняемый файл помещался в созданную папку. И напишите куда можно отправить вам благодарность $. Еще раз благодарю за помощь!kovalrulit
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
Доброго дня знатоки! А если тоже самое, но только не PDF, а просто XLS, без экспорта файла и директория сохранения - рабочий стол? Спасибо-хоть и не шуршит, но от чистого сердца.
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, без экспорта файла и директория сохранения - рабочий стол? Спасибо-хоть и не шуршит, но от чистого сердца.
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, _