エクセル：マクロ：保存時に連番をつける

3シートついたエクセルファイル（雛形）をいつも使うのですが、2シート目のみをデスクトップにある「新しいフィオルダ」に保存したいのですが、マクロで「2シートに行って移動、名前をつけて保存」という過程を記憶させたのですが、いつも同じ名前でしか保存を記憶してないため、「上書きしますか」と出てきてしまいます。自動的に連番かなにかがついて上書きしないで全部ためときたいのですがどうしたらいいでしょうか。
よろしくお願いします。

No.2 ベストアンサー 回答者： taseki 回答日時： 2005/08/02 17:28

連番でも良いですが、桁数の心配が不要で何かと便利だと思うので、日付をファイル名にしてはどうでしょうか。

ツール→マクロ→Visual Basic Editorで、記憶させたマクロを見てください。
たぶん、自動記録の場合は、ファイル保存の部分が以下のようになっていると思います。
ActiveWorkbook.SaveAs Filename:="～デスクトップ\新しいフォルダ\Book1.xls", FileFormat～

これを、以下のように

ActiveWorkbook.SaveAs Filename:="～デスクトップ\新しいフォルダ\" & Format(Date, "Long Date") & ".xls", FileFormat～

もし一日に何度も使う用なら、日付＋時間でもいいですね。

この回答へのお礼

早急なご回答ありがとうございます！
ちょっと手を加えればできそうなので、やってみます。
ありがとうございます！

お礼日時：2005/08/02 19:01

No.3 回答者： Wendy02 回答日時： 2005/08/02 18:07

こんにちは。

「新しいフィオルダ」って「新しいフォルダ」のことかもしれませんが、一応、ご質問文のままにしました。

基調となるファイル名　は、 "Test" にしましたので、Test の後に、ファイルの数が連番でついていきます。これは、Sheet2 のみが保存されます。

Sub TestSample()
　Dim myDeskTop As String, BaseName As String, myDir As String
　Dim f As String, i As Long
　myDeskTop = CreateObject("WScript.Shell").SpecialFolders(1)
　BaseName = "Test" '基調となるファイル名
　myDir = myDeskTop & "\新しいフィオルダ\" 'デスクトップフォルダ
　f = Dir(myDir & BaseName & "*.xls")
　Do While f <> ""
　　i = i + 1
　　f = Dir
　Loop
　Sheets("Sheet2").Copy
　With ActiveWorkbook
　　.SaveAs myDir & BaseName & i + 1 & ".xls"
　　.Close False
　End With
End Sub

この回答へのお礼

早急な御回答ありがとうございます！
そうです、間違えてしまってますね＾＾；新しいフォルダです。
早速やってみます。ありがとうございます。

お礼日時：2005/08/02 19:02

No.1 回答者： 1050YEN 回答日時： 2005/08/02 17:24

>連番

そういう方法もありますが、端末の日付を変えることがないPCでしたら、タイムスタンプをファイル名に付加する方法もあると思いますよ。
連番管理するならば、手で抹消されたファイルも考慮し、連番管理ファイルか何かを用意しなければなりそうなので。。。


タイムスタンプでのサンプルです。
VisualBasicEditorで、雛形のThisWorkBookに以下を張ってみてください。
シート2をアクティブとかのカスタマイズは、そちらでしてください。


Option Explicit

Private Const DEF_FILE_PATH As String = "C:\保存先\" ← 予め、このフォルダを作成かパスを変更してください
Private Const DEF_FILE_NAME As String = "ぶっく"


Private Sub Workbook_BeforeClose(Cancel As Boolean)
　　Dim strFineName As String

　　'変更が無いときは、未処理
　　If ThisWorkbook.Saved Then
　　　　Exit Sub
　　End If
　　
　　'保存先を作成
　　strFineName = DEF_FILE_PATH & DEF_FILE_NAME & "_" & Format(Now, "yyyymmddhhnnss") & ".xls"
　　
　　'名前を付けて保存
　　ThisWorkbook.SaveAs strFineName
　　
　　'保存通知
　　Call MsgBox(strFineName & vbCrLf & "として、保存しました", vbInformation)
End Sub

この回答へのお礼

早急なご回答ありがとうございます。
早速やってみます。

お礼日時：2005/08/02 19:00