
助けて頂いた「ファイルを閉じてダイアログで保存した時だけ処理の実行をする」をメール送信する運用しております。
すべてうまく行っていると思いましたが、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
<以下略>
No.5ベストアンサー
- 回答日時:
こんばんは。
下記でも、エラーになるでしょうか?
'★標準モジュールに記載
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 様
ご対応ありがとうございました!
myShNameでの文字列を付加する事が出来き
すべて思う通りの作動を無事に確認いたしました。
この度は何度もお付き合い、遅くまでありがとうございました。
感謝致します。
No.4
- 回答日時:
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ということでしょうか?
→ブックを表示した時に、一番左にあるシートが1、右隣が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:シート名が入ります。
以下の通り修正しましたが数カ所保存時、起動時にエラーがあります。
★のところは確認、エラーが出る場所です。
-------------------
Public myShFlg() As Boolean ' 動的配列を用意 '←★標準モジュールに記載
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) 'シート数準備
ReDim myShFlg(2 To ThisWorkbook.Sheets.Count) '←★シート2・3の場合はこれでOK?
ReDim myShFlg(3 To ThisWorkbook.Sheets.Count) '←★シート2・3の場合はこれでOK?
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
No.3
- 回答日時:
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
ご回答ありがとうございます。
ReDim myShFlg(1 To ThisWorkbook.Sheets.Count) 'シート数準備
→myShFlg(○…)○の部分をsheet2だと2ということでしょうか?
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)
上記で入力するとコンパイルエラーで赤くなります。
.Subject = myShName ←★Sheet名付加【sheet○】
→シート名だけになりませんか?
申し訳ございません。よろしくお願いいたします。
No.2
- 回答日時:
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が更新、処理~
ご回答ありがとうございます。
以下は、
閉じた(保存)後の処理はこんなイメージでした。
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
On Error GoTo ErrorHandler
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
With objOutlook.CreateItem(olMailItem)
.To = "test@" ←★ここをシート毎に変える
.CC = ""
.BCC = ""
.Subject = "【テスト】自動送信" ←★Sheet名付加【sheet○】
.Body = "このメールはシートの更新テストメールです"
.BodyFormat = olFormatPlain
.Send
End With
Finally:
Set objOutlook = Nothing
Exit Sub
ErrorHandler:
MsgBox "メールの送信に失敗しました", vbOKOnly + vbCritical
Resume Finally
End Sub
No.1
- 回答日時:
こんばんは。
例えば、対象シートの名前が決まっているなら、シート名で判定すれば、
対象シートを絞れるかと。
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などで
取得しておいて、変更のあったシートだけを処理するとかでしょうか?
ご回答ありがとうございます。
Sheetごとに設定したメルアドに配信したいと思っております。
このシートは誰々さんにとか・・・
以下はOutlookからの処理があります。
On Error GoTo ErrorHandler
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
With objOutlook.CreateItem(olMailItem)
.To = "test@"
On Error GoTo ErrorHandler
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
With objOutlook.CreateItem(olMailItem)
.To = "test@"
.CC = ""
.BCC = ""
.Subject = "【テスト】自動送信"
.Body = "このメールは自動テストメールです"
.BodyFormat = olFormatPlain
.Send
End With
Finally:
Set objOutlook = Nothing
Exit Sub
ErrorHandler:
MsgBox "メールの送信に失敗しました", vbOKOnly + vbCritical
Resume Finally
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelマクロのエラーを解決した...
-
XL:BeforeDoubleClickが動かない
-
別のシートを参照して計算する方法
-
ExcelVBA シート名を複数セルか...
-
ExcelのVBAのマクロで他のシー...
-
実行時エラー1004「Select メソ...
-
ユーザーフォームに入力したデ...
-
エクセルVBAで。
-
特定の文字を含むシートだけマ...
-
VBA 指定した回数分、別シート...
-
エクセルのマクロで条件一致の...
-
エクセルVBA Ifでシート名が合...
-
VBA 検索して一致したセル...
-
実行時エラー'1004': WorkSheet...
-
excelのマクロで該当処理できな...
-
【VBA】指定した検索条件に一致...
-
【Excel VBA】シート表示、非表...
-
【VBA】色のついたシート名を取得
-
EXCELVBAを使ってシートを一定...
-
EXCEL VBAで複数シートから該当...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelマクロのエラーを解決した...
-
excelのマクロで該当処理できな...
-
特定の文字を含むシートだけマ...
-
実行時エラー'1004': WorkSheet...
-
ユーザーフォームに入力したデ...
-
【ExcelVBA】全シートのセルの...
-
エクセルVBA Ifでシート名が合...
-
実行時エラー1004「Select メソ...
-
VBA 存在しないシートを選...
-
エクセルで通し番号を入れてチ...
-
VBA 検索して一致したセル...
-
XL:BeforeDoubleClickが動かない
-
VBA 指定した回数分、別シート...
-
VBAマクロでシートコピーした新...
-
シートが保護されている状態で...
-
ブック名、シート名を他のモジ...
-
【VBA】全ての複数シートから指...
-
別のシートから値を取得するとき
-
ExcelのVBAのマクロで他のシー...
-
Excel チェックボックスにチェ...
おすすめ情報