人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルで、
a.xlsを開いたときに自動的行いたい動作があります。

1.
「C:\」に保存してある「b.xls」のバックアップを
「C:\back」に「b_作業当日の日付.xls」という名前で保存したい

2.
「C:\」に保存してある「c.xls」のシート「0811」を
「C:\data」に保存してある「d.xls」にコピーしたい

終了後エクセルを終了させたいです。

どうぞよろしくお願いいたします。

●質問者: ohtsu6
●カテゴリ:コンピュータ
✍キーワード:xls エクセル コピー バックアップ 名前
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● pahoo
●50ポイント

「質問1」のマクロは下記の通り。

コピー先のファイル名の年月日は "b_yyyymmdd.xls" 形式となります。

Sub Auto_Open()
 Dim sour, dest As String
 sour = "C:\b.xls" 'コピー元
 dest = "C:\b_" & Year(Date) & Month(Date) & Day(Date) & ".xls" 'コピー先
 FileCopy sour, dest
 Application.Quit
End Sub

「質問2」について確認をお願いします。

「C:\data」に保存してある「d.xls」にコピーしたい

これは、ブック "c:\data\d.xls" の中にワークシート "0811" を追加していくというイメージですか?


いずれも、Excel VBAよりWSHで書いた方がいいような気がしますが‥‥。

◎質問者からの返答

どうもありがとうございます。

>これは、ブック "c:\data\d.xls" の中にワークシート "0811" を追加していくというイメージですか?

ということでした。

WSHでも可能とのことですが、

今後必要そうになったら、

再度質問させていただきます。

どうもありがとうございます。


2 ● SALINGER
●100ポイント

ThisWorkbookのWorkbook_Open()イベントに次にコードを入れてください。

1.

Private Sub Workbook_Open()
 Dim FSO
 Set FSO = CreateObject("Scripting.FileSystemObject")
 FSO.GetFile("C:\b.xls").Copy "C:\back\b_" & Format(Date, "yyyymmdd") & ".xls"
 
 Set FSO = Nothing
 Application.Quit
End Sub

2.

Private Sub Workbook_Open()
 Workbooks.Open "C:\c.xls"
 Workbooks.Open "C:\data\d.xls"
 Workbooks("c.xls").Worksheets("0811").Copy Workbooks("d.xls").Worksheets(1)
 Application.DisplayAlerts = False
 Workbooks("d.xls").Save
 Workbooks("d.xls").Close
 Application.DisplayAlerts = True
 Workbooks("c.xls").Close

 Application.Quit
End Sub

これでブックをオープンしたときに実行されます。

ただ、マクロのセキュリティが中以上だとマクロを有効にしますか?の画面は出てしまいます。

それでセキュリティを低にすれば表示されなくなりますが、マクロが動くと終了してしまうので編集ができません。

その場合は、別のExcelのファイルを開いてセキュリティを変更してください。

◎質問者からの返答

どうもありがとうございます。

無事にできました。


3 ● Mook
●100ポイント ベストアンサー

EXCEL を使用しなくてもできそうですが、とりあえずEXCELを使用した実装です。

ThisWorkbook の下に保存して実行ください。


補足はコメントで行いますので、有効にお願いいたします。

Private Sub Workbook_Open()
'--- ファイル名の定義
 Const SRC_FILE_B = "C:\b.xls"
 Const SRC_FILE_C = "C:\c.xls"
 Const SRC_FILE_D = "C:\d.xls"
'--- シート名の定義
 Const SRC_SHEET = "0811"
 

'1.
'「C:\」に保存してある「b.xls」のバックアップを
'「C:\back」に「b_作業当日の日付.xls」という名前で保存したい
 Dim dstFile As String
 dstFile = "C:\back\b_" & Format(Date, "YYYYMMDD") & ".xls"
 If Dir(dstFile, vbNormal) <> "" Then
 MsgBox "[" & dstFile & "]は既に存在しています。"
 Exit Sub
 End If
 FileCopy SRC_FILE_B, dstFile

'2.
'「C:\」に保存してある「c.xls」のシート「0811」を
'「C:\data」に保存してある「d.xls」にコピーしたい

 If Dir(SRC_FILE_C, vbNormal) = "" Then
 MsgBox "[" & SRC_FILE_C & "]はありません。"
 Exit Sub
 End If
 
 If Dir(SRC_FILE_D, vbNormal) = "" Then
 MsgBox "[" & SRC_FILE_D & "]はありません。"
 Exit Sub
 End If

 Dim srcWB As Workbook
 Set srcWB = Workbook.Open(SRC_FILE_C)
 
 Dim dstWB As Workbook
 Set dstWB = Workbook.Open(SRC_FILE_D)

 
 srcWB.Worksheets(SRC_SHEET).Copy after:=dstWB.Worksheets(dstWB.Worksheets.Count)
 
 dstWB.Save
 dstWB.Close
 
 Application.DisplayAlerts = False
 srcWB.Close

'--- 終了メッセージ:不要なら次行を削除
 MsgBox "処理を終了しました。"

'3.
'終了後エクセルを終了させたいです。
 ThisWorkbook.Saved = True
 ThisWorkbook.Close False

  ' 他にブックが開いていなければ、Excelを終了する
 If Workbooks.Count <= 1 Then
 Application.Quit
 End If
End Sub

http://officetanaka.net/excel/vba/statement/FileCopy.htm

http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_800_060.html

◎質問者からの返答

どうもありがとうございます。

ファイル名やシート名がたまに変わることがあるので、

定義はとても便利そうです。

Set srcWB = Workbook.Open(SRC_FILE_C)

でエラーになってしまいましたが、

Set srcWB = Workbooks.Open(SRC_FILE_C)

とすることで実行することができるようになりました。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ