Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Сохранение рабочей книги с именем, представляющим собой текущую дату
 
#1
30.10.2010 18:56:54
Помогите пожалуйста исправить, необходимо сохранять книгу не в ту папку, в которой находится исходный файл, так как адрес будет указываться вручную и каждый раз будет отличаться от предыдущего.  
 
Sub SaveAsDate()  
Dim strDate As String  
' Получение текущей даты и представление ее в формате "ддммгг"  
strDate = Format(Now(), "ddmmyy")  
' Сохранение книги в текущую папку под новым именем  
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\" & strDate  
End Sub
 
 
 
#2
30.10.2010 19:18:58
Можно так... адрес - в ячейке А1  
 
Option Explicit  
Sub SaveAsDate()  
Dim strDate, myPath As String  
myPath = Cells(1, 1)  
 
strDate = Format(Now(), "ddmmyy")  
 
   ActiveWorkbook.SaveAs Filename:=myPath & "\" & strDate & ".xls", FileFormat:=xlExcel8  
End Sub
 
 
 
#3
30.10.2010 19:32:31
Скажите пожалуйста, а можно ли адрес указать через диалоговое окно, а не через ячейку А1??? Просто тогда придется адрес вводить вручную.
 
 
 
#4
30.10.2010 19:40:12
Можно...  
 
Option Explicit  
Sub SaveAsDate()  
Dim strDate, myPath As String  
 
myPath = Application.InputBox("Ñîõðàíèòü êíèãó â ïàïêó:", "Ñîõðàíåíèå êíèãè")  
 
strDate = Format(Now(), "ddmmyy")  
 
ActiveWorkbook.SaveAs Filename:=myPath & "\" & strDate & ".xls", FileFormat:=xlExcel8  
End Sub  
 
Но тоже придется вводить вручную... а через графический интерфейс... сложно для меня... может, кто другой напишет..
 
 
 
#5
30.10.2010 19:41:40
ого...  
 
 
Option Explicit  
Sub SaveAsDate()  
Dim strDate, myPath As String  
 
myPath = Application.InputBox("Сохранить книгу в папку:", "Сохранение книги")  
 
strDate = Format(Now(), "ddmmyy")  
 
ActiveWorkbook.SaveAs Filename:=myPath & "\" & strDate & ".xls", FileFormat:=xlExcel8  
End Sub  
 
Вот так :)
 
 
 
#6
30.10.2010 19:46:42
Спасибо Дианочка !!!! Буду пробовать ...
 
 
 
#7
30.10.2010 19:48:11
Function GetPath(Optional sPath$ = "") As String   ' выбор папки  
  If sPath = "" Then sPath = ThisWorkbook.Path  
  If Not Right$(sPath, 1) = "\" Then sPath = sPath & "\"  
  With Application.FileDialog(msoFileDialogFolderPicker)  
     .InitialFileName = sPath: .Title = sGetPathTitle: .ButtonName = "Выбрать"  
     If .Show = 0 Then Exit Function     ' если нажали "Отмена", то GetPath = ""  
     GetPath = .SelectedItems(1)  
  End With  
  If Not Right(GetPath, 1) = "\" Then GetPath = GetPath & "\"  
  GetPath = IIf(ChkPATH(sPath), GetPath, "")  
End Function
С уважением, Алексей
 
 
 
#8
30.10.2010 20:05:30
Alex_ST, что-то ругается на это ... "ChkPATH"
 
 
 
#9
30.10.2010 20:13:19
Пардон, выдернул из другого кода, а там была ещё и функция  
Function ChkPATH(sPath$) As Boolean  ' проверка существования пути к папке или файлу  
  On Error Resume Next  
  ChkPATH = IIf(GetAttr(sPath) + 1, True, False)  
  If GetAttr(sPath) And vbReadOnly Then ChkPATH = False  
End Function  
 
В приведённом мною ранее примере она вообще-то не нужна, но можно и оставить на случай если книга новая и ещё не сохранена (тогда ThisWorkbook.Path="").
С уважением, Алексей
 
 
 
#10
30.10.2010 20:19:18
Большое спасибо Вам !!! ... а теперь вопрос несколько глупее: как этим воспользоваться ??? Т. е. как запустить эту функцию ???
 
 
 
#11
30.10.2010 20:20:35
Здорово.... Спасиб, Alex_ST, это мне тоже пригодится :)  
 
Итого... решение
 
 
 
#12
30.10.2010 20:38:55
Очередное Вам спасибо !!! Скажите, а если мы несколько усложним, т. е. при выборе пути к папке сохранения, предоставим пользователю право самостоятельно выбрать расширение файла (.xls, .xlsx и т. д.) Я сделал скрин, посмотрите ...  
<EM><STRONG>Файл удален</STRONG> - велик размер - [<STRONG>МОДЕРАТОРЫ</STRONG>]</EM>
 
 
 
#13
30.10.2010 20:38:58
Sub SaveAsDate()  
ActiveWorkbook.SaveAs GetPath & Format(Now(), "ddmmyy")  
End Sub  
 
Function GetPath(Optional sPath$ = "") As String   ' выбор папки  
  If sPath = "" Then sPath = ThisWorkbook.Path  
  If Not Right$(sPath, 1) = "\" Then sPath = sPath & "\"  
  With Application.FileDialog(msoFileDialogFolderPicker)  
     .InitialFileName = sPath: .Title = "Выбор папки": .ButtonName = "Выбрать"  
     If .Show = 0 Then Exit Function     ' если нажали "Отмена", то GetPath = ""  
     GetPath = .SelectedItems(1)     ' путь у первому элементу в выбранной папке  
  End With  
  If Not Right(GetPath, 1) = "\" Then GetPath = GetPath & "\"        'если в папке - только файлы  
  GetPath = IIf(ChkPATH(sPath), GetPath, "")  
End Function  
 
Function ChkPATH(sPath$) As Boolean  ' проверка существования пути к папке или файлу  
  On Error Resume Next  
  ChkPATH = IIf(GetAttr(sPath) + 1, True, False)  
  If GetAttr(sPath) And vbReadOnly Then ChkPATH = False  
End Function
С уважением, Алексей
 
 
 
#14
30.10.2010 21:14:45
Файл сохраняется с именем текущей даты с возможностью    
выбора пути сохранения в диалоговом окне
 
 
 
#15
30.10.2010 21:36:12
Спасибо, то, что нужно, только теперь при сохранении появляется предложении сохранить в формате поддерживающем работу макросов ...))  
... Что делать ??  
... можно конечно же оставить и так, но возможно есть выход из этой ситуации ?? ... ведь правда ???
 
 
 
Страницы: 1
Читают тему
Наверх