[[20100427135041]]　『ファイル名に日付を入れて保存する』（蔵ぼう）　ページの最後に飛ぶ

『ファイル名に日付を入れて保存する』（蔵ぼう）

 質問お願いします。

 エクセルファイルを「当日の日付で保存」ではなく、
 「任意の日付(例えばB2セルに入力してある日付)」で保存するには
 どのようにしたらよいでしょうか？

 追記

 ひとつのブックに複数シート(sheet1,sheet2,sheet3)あります。
 そのうちのsheet1のみを新規ブックで、任意の日付で保存したいのです。
 よろしくお願いします。

 すごく乱暴に書くと、こんな感じでしょうか・・・

 Sub test()
    Dim aPath As String, aName As String
    aName = Format(Sheets("Sheet1").Range("B2").Value, "yyyymmdd")
    aPath = ActiveWorkbook.Path
    If aPath = "" Then aPath = Application.DefaultFilePath
    Sheets("Sheet1").Copy
    ActiveSheet.SaveAs aPath & "\" & aName
    ActiveWorkbook.Close False
 End Sub

 (白茶)

レスが遅くなり申し訳ありませんでした。上記コードでうまく動作致します。
本当にありがとうございます。

追加で教えて頂きたいのですが、同じ日付名で複数ファイルができる場合はどうしたら良いでしょうか？

例えば、上記コードでB2セルにはいっている日付が今日であれば、ファイル名は「20100507」ですよね。

上記コードを1回以上繰り返した場合に「上書きしますか？」とのエラーとなってしまいます･･･

ですので、「20100507-1」「20100507-2」などのようにしたいのですが、何か良い方法はないでしょうか？

 白茶さんのコードをお借りすると、以下のようにすれば出来ると思います。

 Sub test()
    Dim aPath As String, aName As String
    aName = Format(Sheets("Sheet1").Range("B2").Value, "yyyymmdd")
    aPath = ActiveWorkbook.Path
    If aPath = "" Then aPath = Application.DefaultFilePath
    '======　ここから追加　======
    Do Until Dir(aPath & "\" & aName & ".xls") = ""
      If aName Like "*-*" Then
        aName = Split(aName, "-")(0) & "-" & Split(aName, "-")(1) + 1
      Else
        aName = aName & "-1"
      End If
      a = Dir(aPath & "\" & aName & ".xls")
    Loop
    '========　ここまで　========
    Sheets("Sheet1").Copy
    ActiveSheet.SaveAs aPath & "\" & aName
    ActiveWorkbook.Close False
 End Sub

 （ｍｏｍｏ）

まさに希望した動作となりました！

本当にありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20100427135041]] 『ファイル名に日付を入れて保存する』（蔵ぼう） ページの最後に飛ぶ

[[20100427135041]]　『ファイル名に日付を入れて保存する』（蔵ぼう）　ページの最後に飛ぶ