Добрый день уважаемые форумчане, Имеется ексел файл с макросом сохранения активного листа. Макрос сохраняет только активный лист без остальных вкладок (что и мне нужно было, спасибо автору), но в сохраненном листе все еще остается кнопка "сохранить лист". Помогите подправить код макроса так чтобы уже в сохраненном листе отсутствовала кнопка "сохранить лист".
[vba]
Код
Sub Сохранение() On Error Resume Next ' название подпапки, в которую по-умолчанию будет предложено сохранить файл Const REPORTS_FOLDER = "C:Users\Aman\Desktop\Games" ' ?создаём папку для файла, если её ещё нет MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ' выбираем стартовую папку ChDrive Left(ThisWorkbook.Path, 1): ChDir "C:\Users\Aman\Desktop\Games"
' вывод диалогового окна для запроса имени сохраняемого файла Filename = Application.GetSaveAsFilename("PO-13-001.xlsx", "Excel (*.xlsx),", , _ "Введите имя файла для сохраняемого отчёта", "Сохранить") ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл If VarType(Filename) = vbBoolean Then Exit Sub
' копируем активный лист (при этом создаётся новая книга) Err.Clear: ActiveSheet.Copy: DoEvents If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа
' убеждаемся, что активной книгой является копия листа If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then ' сохраняем файл под заданным именем в формате Excel 2003 ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
' закрываем сохранённый файл ' (удалите следующую строку, если закрывать созданный файл не требуется) ActiveWorkbook.Close False End If End Sub
[/vba]
Добрый день уважаемые форумчане, Имеется ексел файл с макросом сохранения активного листа. Макрос сохраняет только активный лист без остальных вкладок (что и мне нужно было, спасибо автору), но в сохраненном листе все еще остается кнопка "сохранить лист". Помогите подправить код макроса так чтобы уже в сохраненном листе отсутствовала кнопка "сохранить лист".
[vba]
Код
Sub Сохранение() On Error Resume Next ' название подпапки, в которую по-умолчанию будет предложено сохранить файл Const REPORTS_FOLDER = "C:Users\Aman\Desktop\Games" ' ?создаём папку для файла, если её ещё нет MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ' выбираем стартовую папку ChDrive Left(ThisWorkbook.Path, 1): ChDir "C:\Users\Aman\Desktop\Games"
' вывод диалогового окна для запроса имени сохраняемого файла Filename = Application.GetSaveAsFilename("PO-13-001.xlsx", "Excel (*.xlsx),", , _ "Введите имя файла для сохраняемого отчёта", "Сохранить") ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл If VarType(Filename) = vbBoolean Then Exit Sub
' копируем активный лист (при этом создаётся новая книга) Err.Clear: ActiveSheet.Copy: DoEvents If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа
' убеждаемся, что активной книгой является копия листа If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then ' сохраняем файл под заданным именем в формате Excel 2003 ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
' закрываем сохранённый файл ' (удалите следующую строку, если закрывать созданный файл не требуется) ActiveWorkbook.Close False End If End Sub
Sub Сохранение() On Error Resume Next ' название подпапки, в которую по-умолчанию будет предложено сохранить файл Const REPORTS_FOLDER = "C:Users\Aman\Desktop\Games" ' ?создаём папку для файла, если её ещё нет MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ' выбираем стартовую папку ChDrive Left(ThisWorkbook.Path, 1): ChDir "C:\Users\Aman\Desktop\Games"
' вывод диалогового окна для запроса имени сохраняемого файла Filename = Application.GetSaveAsFilename("PO-13-001.xlsx", "Excel (*.xlsx),", , _ "Введите имя файла для сохраняемого отчёта", "Сохранить") ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл If VarType(Filename) = vbBoolean Then Exit Sub
' копируем активный лист (при этом создаётся новая книга) Err.Clear: ActiveSheet.Copy: DoEvents If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа
' убеждаемся, что активной книгой является копия листа If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then ' сохраняем файл под заданным именем в формате Excel 2003 ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
' закрываем сохранённый файл ' (удалите следующую строку, если закрывать созданный файл не требуется) ActiveWorkbook.Close False End If End Sub
[/vba]
Извиняюсь за символы, Выставил повторно:
[vba]
Код
Sub Сохранение() On Error Resume Next ' название подпапки, в которую по-умолчанию будет предложено сохранить файл Const REPORTS_FOLDER = "C:Users\Aman\Desktop\Games" ' ?создаём папку для файла, если её ещё нет MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ' выбираем стартовую папку ChDrive Left(ThisWorkbook.Path, 1): ChDir "C:\Users\Aman\Desktop\Games"
' вывод диалогового окна для запроса имени сохраняемого файла Filename = Application.GetSaveAsFilename("PO-13-001.xlsx", "Excel (*.xlsx),", , _ "Введите имя файла для сохраняемого отчёта", "Сохранить") ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл If VarType(Filename) = vbBoolean Then Exit Sub
' копируем активный лист (при этом создаётся новая книга) Err.Clear: ActiveSheet.Copy: DoEvents If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа
' убеждаемся, что активной книгой является копия листа If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then ' сохраняем файл под заданным именем в формате Excel 2003 ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
' закрываем сохранённый файл ' (удалите следующую строку, если закрывать созданный файл не требуется) ActiveWorkbook.Close False End If End Sub
Digital, сообщения можно редактировать. Чтоб оформить код тегами нажмите значок # на панели редактирования. По теме: [vba]
Код
If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then ActiveWorkbook.ActiveSheet.drawingobjects.delete ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
[/vba]И исправьте свои сообщения, видите, как выглядит мой код?
Digital, сообщения можно редактировать. Чтоб оформить код тегами нажмите значок # на панели редактирования. По теме: [vba]
Код
If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then ActiveWorkbook.ActiveSheet.drawingobjects.delete ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
[/vba]И исправьте свои сообщения, видите, как выглядит мой код?KuklP
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728