Добрый день! Подскажите, пожалуйста, как сохранить лист в отдельный файл с 1. заменой формулы на значение 2. что бы в сохранном файле отсутствовали макросы 3. что бы автоматически сохранялось на рабочий стол 4. что бы название созданного файла состояло из значений нескольких ячеек (к примеру A1,C1,I2)
Нужно для создания отчета на работе, подобную, почти подходящую формулу я нашел в рубрике ГОТОВЫЕ РЕШЕНИЯ но она дает название файла из названия листа, а хотелось бы, что бы название брало из ячеек. Помогите, пожалуйста, отредактировать либо эту формулу, либо написать новую, а то я второй день пытаюсь, что-то там изменить но у меня не получается ибо не хватает знаний в области VBA
Формулу прилагаю (полностью скопирована из рубрики "Готовые решения"): [vba]
Код
Sub Лист_в_файл() 'Сохранить текущий лист. Dim List$, iPath$
iPath = "D:\Папка\папка\" ' конкретный адрес для сохранения нового файла
Application.ScreenUpdating = False Application.DisplayAlerts = False List = ActiveSheet.Name Sheets(List).Copy Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value Sheets(List).Buttons.Delete 'Удаляем кнопки 'Sheets(List).DrawingObjects.Delete 'Удаляем все элементы ActiveWorkbook.SaveAs iPath & List '& ".xls" ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Готово!" End Sub
[/vba]
Добрый день! Подскажите, пожалуйста, как сохранить лист в отдельный файл с 1. заменой формулы на значение 2. что бы в сохранном файле отсутствовали макросы 3. что бы автоматически сохранялось на рабочий стол 4. что бы название созданного файла состояло из значений нескольких ячеек (к примеру A1,C1,I2)
Нужно для создания отчета на работе, подобную, почти подходящую формулу я нашел в рубрике ГОТОВЫЕ РЕШЕНИЯ но она дает название файла из названия листа, а хотелось бы, что бы название брало из ячеек. Помогите, пожалуйста, отредактировать либо эту формулу, либо написать новую, а то я второй день пытаюсь, что-то там изменить но у меня не получается ибо не хватает знаний в области VBA
Формулу прилагаю (полностью скопирована из рубрики "Готовые решения"): [vba]
Код
Sub Лист_в_файл() 'Сохранить текущий лист. Dim List$, iPath$
iPath = "D:\Папка\папка\" ' конкретный адрес для сохранения нового файла
Application.ScreenUpdating = False Application.DisplayAlerts = False List = ActiveSheet.Name Sheets(List).Copy Sheets(List).UsedRange.Value = Sheets(List).UsedRange.Value Sheets(List).Buttons.Delete 'Удаляем кнопки 'Sheets(List).DrawingObjects.Delete 'Удаляем все элементы ActiveWorkbook.SaveAs iPath & List '& ".xls" ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True MsgBox "Готово!" End Sub
п.4 требует (теоретически и оочень часто практически) ещё одной обработки полученного значения - перед применением убить все символы, которые не могут быть в имени файла.
п.4 требует (теоретически и оочень часто практически) ещё одной обработки полученного значения - перед применением убить все символы, которые не могут быть в имени файла.Hugo
Помогите решить такую проблему: есть файл, в котором на первом листе исходные данные и кнопка, на втором расчеты, на третьем - результат с формулами. Необходимо чтобы при нажатии кнопки создавалась папка "Двери" в текущей папке, где лежит этот файл (а если она есть, то сохранялось в нее), а имя файла бралось с листа 2 из ячеек a17 & b17. Сохраняться должен третий лист (он скрыт), формулы на нем нужно заменить на значения. После сохранения новая книга закрывается и выводится сообщение об удачном сохранении файла с присвоенным именем из ячеек a17 & b17.
Я понимаю что все это уже было описано и не один раз и на разных форумах, но там либо идет сохранение только текущего листа, либо нужный лист, но нет замены формул на значения и т.п. - короче немного не то как мне надо. Сам я пытаюсь уже неделю соединить части разных кодов методом тыка, но знаний по программированию в VBA, к сожалению, у меня нет, поэтому ничего стоящего не получается. Вот пример кода, взятого с разных форумов, но лист не хочет сохраняться с указанным именем (используется имя по умолчанию "Книга 2...Книга 3...). и также непонятно мне как сделать чтобы выскакивало сообщение о результате сохранения. Подскажите пожалуйста.
Sub Ведомость_1()
On Error Resume Next Const REPORTS_FOLDER = "Двери\" ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ' создаём папку для файла, если её ещё нет
Filename = Range("a17") & ("b17") & ".xls" ' вывод диалогового окна для запроса имени сохраняемого файла
If VarType(Filename) = vbBoolean Then Exit Sub ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n
Select Case Sheets(1).[Условие] Case 1 Ar = Array(3) Case Else End Select
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1) For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next ThisWorkbook.Worksheets(ArAll).Copy Application.Volatile Application.Calculate Application.ScreenUpdating = False For Each n In Ar With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With Next Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1)) For Each Sh In ActiveWorkbook.Worksheets If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 Else: If Sh.Visible = False Then Sh.Visible = True End If Next ActiveWorkbook.Sheets(Ar(0)).Activate Application.DisplayAlerts = False ActiveWorkbook.Worksheets(ArAll).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show
ActiveWorkbook.Close False End Sub
Здравствуйте, уважаемые форумчане.
Помогите решить такую проблему: есть файл, в котором на первом листе исходные данные и кнопка, на втором расчеты, на третьем - результат с формулами. Необходимо чтобы при нажатии кнопки создавалась папка "Двери" в текущей папке, где лежит этот файл (а если она есть, то сохранялось в нее), а имя файла бралось с листа 2 из ячеек a17 & b17. Сохраняться должен третий лист (он скрыт), формулы на нем нужно заменить на значения. После сохранения новая книга закрывается и выводится сообщение об удачном сохранении файла с присвоенным именем из ячеек a17 & b17.
Я понимаю что все это уже было описано и не один раз и на разных форумах, но там либо идет сохранение только текущего листа, либо нужный лист, но нет замены формул на значения и т.п. - короче немного не то как мне надо. Сам я пытаюсь уже неделю соединить части разных кодов методом тыка, но знаний по программированию в VBA, к сожалению, у меня нет, поэтому ничего стоящего не получается. Вот пример кода, взятого с разных форумов, но лист не хочет сохраняться с указанным именем (используется имя по умолчанию "Книга 2...Книга 3...). и также непонятно мне как сделать чтобы выскакивало сообщение о результате сохранения. Подскажите пожалуйста.
Sub Ведомость_1()
On Error Resume Next Const REPORTS_FOLDER = "Двери\" ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER ' создаём папку для файла, если её ещё нет
Filename = Range("a17") & ("b17") & ".xls" ' вывод диалогового окна для запроса имени сохраняемого файла
If VarType(Filename) = vbBoolean Then Exit Sub ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n
Select Case Sheets(1).[Условие] Case 1 Ar = Array(3) Case Else End Select
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1) For Each Sh In ThisWorkbook.Worksheets ArAll(n) = Sh.Index n = n + 1 Next ThisWorkbook.Worksheets(ArAll).Copy Application.Volatile Application.Calculate Application.ScreenUpdating = False For Each n In Ar With ActiveWorkbook.Worksheets(n).UsedRange.Cells .Value = .Value End With Next Erase ArAll: n = 0 ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1)) For Each Sh In ActiveWorkbook.Worksheets If IsError(Application.Match(Sh.Index, Ar, 0)) Then ArAll(n) = Sh.Index n = n + 1 Else: If Sh.Visible = False Then Sh.Visible = True End If Next ActiveWorkbook.Sheets(Ar(0)).Activate Application.DisplayAlerts = False ActiveWorkbook.Worksheets(ArAll).Delete Application.DisplayAlerts = True Application.ScreenUpdating = True Application.Dialogs(xlDialogSaveAs).Show