【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする

Question

助けて頂いた「ファイルを閉じてダイアログで保存した時だけ処理の実行をする」をメール送信する運用しております。
すべてうまく行っていると思いましたが、5つあるsheetの中で関係ないSheetで更新があった時でもメールが配信される為、更新の多い時がありクレームがありました。
Private Sub Workbook_〇〇をWorksheet_○○に変えればよいのでしょうか？
ThisWorkbookからSheet1，2・・に書き写せば良いかと思いましたが無理でした。
Sheetごとの「Sheet○が更新し閉じた時～」にする事は可能でしょうか？
よろしくお願いいたします。

Option Explicit
Private SavedFlg As Boolean
Private ChangeFlg As Boolean 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, Sh.Range("A1:A100")) Is Nothing Then Exit Sub
    ChangeFlg = True
End Sub

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    SavedFlg = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Const olMailItem = 0
    Const olFormatPlain = 1
    If Not Saved Then
        Select Case MsgBox("'" & ThisWorkbook.Name & "' の変更内容を保存しますか？", vbExclamation + vbYesNoCancel)
            Case vbYes
                Application.EnableEvents = False
                ThisWorkbook.Save
                Application.EnableEvents = True
                SavedFlg = True
            Case vbNo
                ThisWorkbook.Saved = True
            Case vbCancel
                Cancel = True
                Exit Sub
        End Select
    End If
    If Not ChangeFlg Then Exit Sub
    If Not SavedFlg Then Exit Sub
＜以下略＞

mygoonickname · Accepted Answer

こんばんは。

下記でも、エラーになるでしょうか？

'★標準モジュールに記載
Public myShFlg() As Boolean ' 動的配列を用意

'★Thisworkbookに下記を記載
Option Explicit
Private SavedFlg As Boolean
Private ChangeFlg As Boolean

’
Private Sub Workbook_Open()
Dim I As Long
ReDim myShFlg(1 To ThisWorkbook.Sheets.Count) 'シート数準備
For I = 1 To ThisWorkbook.Sheets.Count
myShFlg(I) = False '念のために全てFalseをセット '←★エラーになります
Next I
End Sub

'範囲指定
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Intersect(Target, Sh.Range("B2:J10")) Is Nothing Then Exit Sub
ChangeFlg = True
myShFlg(Sh.Index) = True '更新されたシートのフラグをTrueに　　'←★エラーになります
If Application.Intersect(Target, Sh.Range("A2:J10")) Is Nothing Then
Exit Sub
End Sub

'保存
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
SavedFlg = True
End Sub
以下、Workbook_BeforeCloseとSub myMailSend

mygoonickname · Answer

No.1の者です。

すみません、下記修正になります。　myMailSendが抜けていました。
If myShFlag(1) Then Call("test@1",worksheets(1).Name)
↓
If myShFlag(1) Then Call myMailSend("test@1",worksheets(1).Name)

＞myShFlg(○…)○の部分をsheet2だと2ということでしょうか？
→ブックを表示した時に、一番左にあるシートが１、右隣が２ですね。

＞.Subject = myShName　　　　　←★Sheet名付加【sheet○】
＞シート名だけになりませんか？
→シート名だけだと思いますが。。。

Call myMailSend("test@1",worksheets(1).Name)　で読んで、
Sub myMailSend(myToAdd As String,myShName As String)
が呼ばれる。　処理がこちらに移ります。　その際、
myToAddには、"test@1"が入ります。
myShNameには、worksheets(1).Name：シート名が入ります。

mygoonickname · Answer

No.1の者です。

シートが2枚変更があったら、メールを2通送信するで良いでしょうか？
イメージ的には、下記の様な感じでどうでしょうか？
手入力ですので、エラーが出たら、修正して下さい。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Const olMailItem = 0
Const olFormatPlain = 1

'途中省略

If Not ChangeFlg Then Exit Sub
If Not SavedFlg Then Exit Sub

If myShFlag(1) Then Call("test@1",worksheets(1).Name)
If myShFlag(2) Then Call("test@2",worksheets(2).Name)
If myShFlag(3) Then Call("test@3",worksheets(3).Name)
'必要に応じて、45と追加。

Exit sub

Sub myMailSend(myToAdd As String,myShName As String)
On Error GoTo ErrorHandler
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
With objOutlook.CreateItem(olMailItem)
.To = myToAdd　　　　　　　　　　　　　　←★ここをシート毎に変える
.CC = ""
.BCC = ""
.Subject = myShName　　　　　←★Sheet名付加【sheet○】
.Body = "このメールはシートの更新テストメールです"
.BodyFormat = olFormatPlain

'途中省略

Resume Finally
End Sub

mygoonickname · Answer

No.1の者です。

？？？
シート毎でしたら、配列を用意して、どのシートが更新されたかをフラグに
入れておいて、後ほどそのフラグをチェックするでしょうか？

'標準モジュールに下記を記載
Public myShFlg() As Boolean ' 動的配列を用意

'Thisworkbookに、下記を記載
Private Sub Workbook_Open()
    Dim I As Long
    ReDim myShFlg(1 To ThisWorkbook.Sheets.Count) 'シート数準備
    For I = 1 To ThisWorkbook.Sheets.Count
        myShFlg(I) = False '念のために全てFalseをセット
    Next I
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, Sh.Range("A1:A100")) Is Nothing Then Exit Sub
    myShFlg(Sh.Index) = True '更新されたシートのフラグをTrueに
End Sub

'処理する部分で、フラグで判定して処理する
If myShFlag(1) Then 'シート1が更新、処理～
If myShFlag(2) Then 'シート2が更新、処理～
If myShFlag(3) Then 'シート3が更新、処理～

mygoonickname · Answer

こんばんは。

例えば、対象シートの名前が決まっているなら、シート名で判定すれば、
対象シートを絞れるかと。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Sh.Range("A1:A100")) Is Nothing Then Exit Sub
If Sh.Name ＝ 〇〇 or Sh.Name ＝ △△ Then ChangeFlg = True
End Sub

若しくは、配列を用意し、どのシートが変更されたかを、Sh.Indexなどで
取得しておいて、変更のあったシートだけを処理するとかでしょうか？

【変更】ファイルを閉じてダイアログで保存した時、更新したシートだけの処理の実行をする

こんばんは。

No.1の者です。

No.1の者です。

No.1の者です。

こんばんは。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング