Страницы: 1
RSS
Сохранение текущего файла с заданным именем через стандартный диалог
 
Добрый день!
Нужно сохранить открытую книгу через стандартный диалог, но с предопределенным именем. + timestamp
Пробовал переписать "под себя" http://www.excelworld.ru/forum/3-1293-14737-16-1328619875
Код
Sub Save_Copy_As1()
   ' Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Dim ShName As String, FName As String
    Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"    ' суффикс к имени файла копии - дата и время сохренения копии файла
    'sSuff = "[2015-04-14]"
    ShName = ActiveSheet.Name & sSuff
    FName = Application.GetSaveAsFilename(InitialFileName:=ShName, _
        FileFilter:="Excel Files (*.xls), *.xls", Title:="Выберите папку для сохранения")
    ActiveWorkbook.Close saveChanges:=True, FileName:=FName
End Sub

Имя файла не подставляется, пробовал сокращать длину sSuff - сохраняет когда нет точек в дате, хотя в примере по ссылке сохраняет с точками, но как копию.
Изменено: К М - 15.04.2015 11:57:18
Karim
 
Квадратные скобки в имени файла недопустимы. Посмотрите код. Выбираете папку - сохраняется файл (НЕ КОПИЯ!!!) с добавлением даты и времени к имени
Код
Sub Save_Copy_As1()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        With .FileDialog(msoFileDialogFolderPicker)
            If .Show = False Then Exit Sub
            sFolder = .SelectedItems(1)
        End With
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    BaseName = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name)
    FName = sFolder & BaseName & "_" & Format(Now, "yyyy/mm/dd-hh.mm.ss") & ".xlsm"
    ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал: Квадратные скобки в имени файла недопустимы.
Странная ситуация... макрос по ссылке из первого поста сохранял со скобками без проблем, но копию.

Пример навороченный вариант:
Код
Sub Save_Copy_As_Now()
'---------------------------------------------------------------------------------------
' Procedure    : Save_Copy_As_Now
' Author       : Alex_ST
' Topic_HEADER : Макрос Save_Copy_As
' Topic_URL    : http://www.excelworld.ru/forum/3-1293-14737-16-1328619875
' DateTime     : 07.02.12, 17:04
' Purpose      : Сохранение копии активного файла с запоминанием папки для сохранения
' Notes        : Путь сохранения копий хранится в коллекции .Names книги (в именованном диапазоне)
'---------------------------------------------------------------------------------------
   Const sPath_in_Names = "Path4SaveCopyAs"   ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла
   Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"    ' суффикс к имени файла копии - дата и время сохренения копии файла
   Dim FileName, sExp$, sDirPath$
   With ActiveWorkbook
      FileName = .Name   ' например, "Книга1.xls"
      sExp = "." & Split(FileName, ".")(UBound(Split(FileName, ".")))   ' расширение файла вместе с точкой (например, ".xls")
      FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp   ' например, "Книга1 [2012.02.06 15-24'39''].xls"
      On Error Resume Next
      sDirPath = .Names(sPath_in_Names).Value   ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names
      If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value   ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path
      sDirPath = Split(sDirPath, """")(1)   ' убрать из считанного значения =" в начале и " в конце
      sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\")  ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша)
      .Names(sPath_in_Names).Value = sDirPath   ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names
REPEAT_:
      FileName = Application.GetSaveAsFilename(InitialFileName:=sDirPath & FileName, _
                                               FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _
                                               Title:="Сохранение копии файла")   'задать путь сохранения и имя копии файла в окне выбора
      If VarType(FileName) = vbBoolean Then Exit Sub   ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем
      If FileName = .FullName Then MsgBox "Нельзя сохранить файл под именем открытой книги!", 16, "Ошибка": GoTo REPEAT_
      sDirPath = Left(FileName, InStrRev(FileName, "\"))   ' путь к папке сохранения копий без имени файла
      .Names(sPath_in_Names).Value = sDirPath   ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names
      .SaveCopyAs FileName
   End With
End Sub
Function Replace_UnLegalChr$(ByVal sFileName$)   ' замена не допустимых символов в именах файлов
   Const sUnLegalChr$ = "/\:*?<>|"""   ' символы, не допустимые в именах файлов Windows
   Dim i%
   For i = 1 To Len(sUnLegalChr)
      sFileName = Replace(sFileName, Mid(sUnLegalChr, i, 1), "_")
   Next i
   Replace_UnLegalChr = sFileName
End Function

Изначально мне нужно сохранить лист как отдельный файл (с заданным именем в указанной папке) и оставить его открытым.
С копированием листа и созданием новой книги проблем нет.
Не могу сделать "красивое" сохранение.

Может есть вариант лучше?
Изменено: К М - 16.04.2015 01:42:50
Karim
 
Цитата
1) К М написал: Нужно сохранить открытую книгу через стандартный диалог
Цитата
2) К М написал: Изначально мне нужно сохранить лист как отдельный файл
Так что нужно? Книга и Лист вещи разные.

Цитата
К М написал: Может есть вариант лучше?
Я макрос для первого вопроса написал
Согласие есть продукт при полном непротивлении сторон
 
Все верно.
У меня есть Книга с несколькими листами, в один из них формирую отчет.
Этот отчет и нужно сохранить как отдельную книгу и оставить открытым.

Из исходной книги я уже скопировал нужный лист в отдельный документ (в виде отчета без макросов, формул итд) его мне и нужно сохранить с нужным именем.
Ваш Первый макрос не совсем подходит, тк он ссылается на книгу из которой запущен.

Пока решил очень коряво - но нужный результат получил.
0) копирую лист в отдельную книгу
1) сохраняю как копию (с квадратными скобками, таймстампом и др)
2) закрываю книгу
3) открываю только что сохраненный файл

Хочу просто сохранить и оставить активным на пункте 1)
Изменено: К М - 16.04.2015 01:43:35
Karim
Страницы: 1
Наверх