| |
kanabun さん
回答ありがとうございます。
教えて頂いたものと今まで組んだものとあわせて、
下記のような感じになりました。
Private Sub Workbook_Open()
Application.Calculation = xlCalculationManual
Dim dt As Date
Dim strPath As String
Dim ss As String
If InStr(ActiveWorkbook.Name, "月分") Then Exit Sub
strPath = "C:\報告関連"
dt = DateAdd("m", -1, Date)
ss = strPath & "\" & Format(dt, "yyyy")
If Dir(ss, vbDirectory) = "" Then
MkDir ss
MsgBox ("あけましておめでとうございます。今年もがんばりましょう。")
End If
ss = strPath & "\" & Format(dt, "yyyy\\m月度")
If Dir(ss, vbDirectory) = "" Then
MkDir ss
MsgBox ("月が替わったのでフォルダを作り保存し、データを初期化します。")
ThisWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & Format(dt, "yyyy\\m月度") & "\報告書（" & Format(dt, "m月分") & "）.xls"
Windows("報告書.xls").Activate
Sheets("集計1").Select
Range("A:AX").ClearContents
Range("Q1").Value = Format(Date, "yyyy/mm/01")
Range("A1").Select
Sheets("集計2").Select
Range("N:U").ClearContents
Calculate
Range("A1").Select
Sheets("報告1").Select
End If
End Sub
本当に助かりました。ありがとうございます。
>▼かもめ さん：
>こんにちは。
>
>>Workbook_Openのマクロで
>>ファイル名に「月分」という2文字が入っていたら、
>>Workbook_Openのマクロを実行しない。
>>という命令は可能でしょうか。
>
>Book名に「月分」という文字列が含まれるかを調べるには
>InStr関数とか、
>Like演算子
>で可能です。
>たとえば、
>開いたWorkbookの名前を Like演算子で調べるなら、
> If ActiveWorkbook.Name Like "*月名*" Then
>といった風です。
>
>>※こちらで月が替わっていたらフォルダを作成して
>> コピーを保存し、中身のデータを消すというマクロを質問し、
>> おかげさまで作ることが出来たのですが、
>
>いまどんなふうにコードを書いてますか？
>下記は、存在しない階層フォルダを一気に作成するAPI と
>元のBookは無くさないで、そのBookのCopyを
>名前をつけて作成するサンプルです。
>
>'---------------------- 標準モジュール
>Declare Function SHCreateDirectoryExA Lib "shell32" ( _
> ByVal hwnd As Long, _
> ByVal pszPath As String, _
> ByVal psa As Long) As Long
>Sub BackUpファイルの保存()
> Dim myBackupPath As String
> Dim myBackupName As String
> Dim ok As Long
>
> '▼ファイル名に "月分" という文字列があるか調べる
> ' あったら 以下のマクロは実行しない
> If InStr(ActiveWorkbook.Name, "月分") Then Exit Sub
>
> '▼Backup Folderの一気作成
> myBackupPath = "D:\(Data)\報告関連\2010\3月度\"
> myBackupName = "報告書(3月分).xls"
> ok = SHCreateDirectoryExA(0&, myBackupPath, 0&)
>
> '▼BookのBackUp保存 (対象Bookそのものはそのまま残す)
> ActiveWorkbook.SaveCopyAs myBackupPath & myBackupName
>
> '▼Bookの内容Clear
> ActiveSheet.UsedRange.ClearContents
>
>End Sub
>
>参考URL (存在しないパスのフォルダを一発で作成する)
>h t tp://officetanaka.net/other/extra/tips07.htm
|
|
かもめ
- 10/3/29(月) 12:21 -
