Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2979 / 13644 ツリー ←次へ | 前へ→

【64943】ファイル名に特定の文字がある場合は実行しない かもめ 10/3/28(日) 21:22 質問[未読]
【64944】Re:ファイル名に特定の文字がある場合は実... kanabun 10/3/28(日) 23:36 発言[未読]
【64949】Re:ファイル名に特定の文字がある場合は実... かもめ 10/3/29(月) 12:21 お礼[未読]
【64945】Re:ファイル名に特定の文字がある場合は実... kanabun 10/3/28(日) 23:42 発言[未読]

【64943】ファイル名に特定の文字がある場合は実行...
質問  かもめ  - 10/3/28(日) 21:22 -

引用なし
パスワード
   Excel2003です。

Workbook_Openのマクロで
ファイル名に「月分」という2文字が入っていたら、
Workbook_Openのマクロを実行しない。
という命令は可能でしょうか。

※こちらで月が替わっていたらフォルダを作成して
 コピーを保存し、中身のデータを消すというマクロを質問し、
 おかげさまで作ることが出来たのですが、
 
 月が替わって最初に開いたブックが過去フォルダ内のコピーだった場合、
 このマクロが実行されてしまい過去分のコピーからデータが消去されて
 しまうことがわかりました。
 なので、過去のバックアップのファイル名に含まれる「月分」を
 判断材料にしてマクロを実行しない方法を考えています。
 

【64944】Re:ファイル名に特定の文字がある場合は...
発言  kanabun  - 10/3/28(日) 23:36 -

引用なし
パスワード
   ▼かもめ さん:
こんにちは。

>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

【64945】Re:ファイル名に特定の文字がある場合は...
発言  kanabun  - 10/3/28(日) 23:42 -

引用なし
パスワード
   ↑補足です

>  myBackupPath = "D:\(Data)\報告関連\2010\3月度\"
は、
そちらの環境に合わせて変更してくださいね。

【64949】Re:ファイル名に特定の文字がある場合は...
お礼  かもめ  - 10/3/29(月) 12:21 -

引用なし
パスワード
   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

2979 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free