エクセルブック内の決められた文字列の有無を確認するには？

質問

既存ブックを開いて、編集後閉じるときにそのブック内にある文字列が含まれているかを確認する方法はありませんでしょうか？セル内に「氏名」とか「電話番号」とかの文字列が含まれているブックを閉じたときにメッセージを出すアドインを作りたいのです。全セルの値を探すのでは時間がかかってしまうのでそれ以外でいい方法がないかを知りたいのですが・・・

回答No.6

Wendy02 · ベストアンサー

返事が遅くなりました。

私が紹介したツール xdoc2txt.exe を使ったものは、かなり商品化しているものもあるので、使える人には、便利なツールです。

それから、『Personal.xls』のクラスに登録する件は、訂正します。Excelのアプリケーションとしてあるものは、さまざまなファイルの種類があるので、慎重に行わないといけないとことが分かりました。単にブックにマクロを組むのとは違いましたので、十分に、考えられるだけのケースを想定して何度も検討しなおしました。内容的にはそっくりでも、まったく違うものとして考えたほうがよかったでしたた。

　※　必ず『不必要になったら、削除してください』
　　　ある種、その目的が分かっていないと、うっとうしさがあります。

本来は、アドイン化するのが筋なのですが、アドイン化は、１つのパッケージとして行うもので、掲示板等では、安易にお勧めしかねます。

それから、今回のコードは、非表示シートは、検索しません。アドインの中も検索しません。

//修正版// Personal.xls編

'<Class1モジュール>
Option Explicit
Public WithEvents App As Application

Private Sub App_WorkbookBeforeClose(ByVal wb As Workbook, Cancel As Boolean)
Dim WbName As String
Application.EnableEvents = False
On Error Resume Next
WbName = StrConv(wb.Name, vbLowerCase)
If InStr(WbName, ".xla") = 0 And _
　　　InStr(WbName, "personal") = 0 And _
　　　Not WbName = Empty Then
　　End If
On Error GoTo 0
　Call FindWords(wb)
If FindWordsflg = True Then
　　If MsgBox(WbName & " には、" & Chr(10) & FindMsg & _
　　　 "が含まれています。" & Chr(10) & "終了を止めますか？", 16 + 4) = vbYes Then
　　　Cancel = True
　　　FindWordsflg = False
　　End If
End If
　Application.EnableEvents = True
End Sub

'<標準モジュール登録です。>
Option Explicit
Public FindWordsflg As Boolean
Public FindMsg As String
Sub FindWords(ByVal wb As Workbook)
Dim SearchWord As Variant
Dim Rng As Range
Dim i As Integer, j As Integer
FindMsg = ""
FindWordsflg = False
SearchWord = Array("住所", "氏名", "電話")
With wb
　On Error GoTo EndLine
　For j = 1 To .Worksheets.Count
　　With .Worksheets(j)
　　　 If .Visible > -1 Then Exit For
　　　For i = LBound(SearchWord) To UBound(SearchWord)
　　　　Set Rng = .Cells.Find(What:=SearchWord(i), _
　　　　After:=ActiveCell, _
　　　　LookIn:=xlValues, LookAt:=xlPart, _
　　　　SearchOrder:=xlByRows, _
　　　　SearchDirection:=xlNext, _
　　　　MatchCase:=False)
　　　　If Not Rng Is Nothing Then
　　　　　FindMsg = FindMsg & .Name & "　: " & SearchWord(i) & _
　　　　　Chr(13)
　　　　　FindWordsflg = True
　　　　　Set Rng = Nothing
　　　　End If
　　　Next i
　　End With
　Next j
End With
EndLine:
Set wb = Nothing
End Sub

'<ThisWorkbook >
Dim myClass As New Class1
Private Sub Workbook_Open()
　 Set myClass.App = Application
End Sub

お礼

お忙しいところいろいろご検討いただきありがとうございます。personal.xls版としてご教授いただいたもので、やりたかった事は出来ました。参考にさせていただきます。お忙しい中本当にありがとうございました。

回答No.5

Wendy02

私のはあまり参考にならないかもしれませんね。

＞全てのブックを対象にするのは、結構うっとおしいので、

最初に、xdoc2txt.exe というフリーソフトウェアがあります。
これは、Excelの必要なブックを全てText ファイルに落としてしまうものです。text に落としたものから、検索すると非常に速いです。ブックの開け閉めはしませんからね。
マクロからでも利用できますが、今の所、私の方ではそのコードを公開する予定がありません。

xdoc2txt （フリーソフトウェア）
http://www31.ocn.ne.jp/~h_ishida/xdoc2txt.html

また、KWIC Finder
http://www31.ocn.ne.jp/~h_ishida/KWIC.html
というのは、それをアプリケーションにしたものです。
バイナリ検索は、シェアウェアです。

a269783255様へ。
参考にさせていただきましたが、気を悪くなさらないでくださいね。

'<標準モジュール登録です。>
Option Explicit
Private FindWordsflg As Boolean
Private FindMsg As String
Private Sub FindWords()
Dim SearchWord As Variant
Dim Rng As Range
Dim i As Integer, j As Integer
FindMsg = ""
FindWordsflg = False
SearchWord = Array("住所", "氏名", "電話")
For j = 1 To .Worksheets.Count
　With .Worksheets(j)
　For i = LBound(SearchWord) To UBound(SearchWord)
　 Set Rng = .Cells.Find(What:=SearchWord(i), _
　　　　　　After:=ActiveCell, _
　　　　　　LookIn:=xlValues, LookAt:=xlPart, _
　　　　　　SearchOrder:=xlByRows, _
　　　　　　SearchDirection:=xlNext, _
　　　　　　MatchCase:=False)
　　If Not Rng Is Nothing Then
　　　FindMsg = FindMsg & .Worksheets(j).Name & ": " & SearchWord(i) & Chr(10)
　　　FindWordsflg = True
　　　Set Rng = Nothing
　　End If
　 Next i
　 End With
　 Next j
End Sub

Sub Auto_Close()
Call FindWords
If FindWordsflg = True Then
　　If MsgBox("このブックには、" & Chr(10) & FindMsg & "が含まれています。" & Chr(10) & _
　　　 "終了を止めますか？", 16 + 4) = vbYes Then
　　　Application.ExecuteExcel4Macro "Halt(True)"
　　　Exit Sub
　　Else
　　　ThisWorkbook.Save
　　End If
End If
End Sub

＞「ActiveWorkbook.Save」と記述を追加するだけで済む様にするためです。

ActiveWorkbook　に対するイベントは、一旦、インスタンスを作らないといけないと思います。それで、一番良いのは、Personal.xls になるかと思います。新しく開いたものに、イベントのインスタンスを作ります。

'<Class1モジュール>
Public WithEvents App As Application
Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Call FindWords
If FindWordsflg = True Then
　　If MsgBox("このブックには、" & Chr(10) & FindMsg & "が含まれています。" & Chr(10) & _
　　　 "終了を止めますか？", 16 + 4) = vbYes Then
　　　'Application.ExecuteExcel4Macro "Halt(True)"
　　　Cancel = True
　　　Exit Sub
　　Else
　　　Wb.Close True
　　End If
End If
End Sub

'<標準モジュール>　'一番上に登録
Public FindWordsflg As Boolean
Public FindMsg As String
Public myClass As Class1
Private FindWordsflg As Boolean
' -略 -
End Sub

Sub Auto_Open()
Set myClass = New Class1
Set myClass.App = Application
End Sub

お礼

ツールの紹介までいただきありがとうございます。とても有用なツールですね。実はこういうものも探しておりましたので、利用させていただこうと思います。ところでWendy02様の書いたコードを試す場合は、
アドインとするプロシージャとして
Sub FindWords()、Sub Auto_Close()
を標準モジュール上に記述し、
Personal.xls 上のクラスモジュール上に
Sub App_WorkbookBeforeClose(ByVal Wb As Workbook Cancel As Boolean)
標準モジュール上に
Sub Auto_Open()、Sub FindWords()
を記述するということでよろしいのでしょうか？
まだまだ初心者でWendy02様の内容を全て理解しきれていなく申し訳ありませんが、お教えいただければ幸いです。

回答No.4

a269783255

お役に立てそうで良かったです。
>「ファイルメニュー→閉じる」や～拾えないのでしょうか？
こちらのサンプルでは、どちらも拾えました。
先の補足ですが、
「Call test1」
とわざわざサブルーチンを呼び出す様にしてあるのは、
「変更を保存しますか？」のメッセージを出さずに、
いきなり上書き保存の処理にしたい時、
「Call test1」の下へ
「ActiveWorkbook.Save」と記述を追加するだけで済む様にするためです。

お礼

度々ありがとうございます。もう少しだけご教授いただけませんでしょうか？やはり「ファイルメニュー→閉じる」では拾えませんでした。根本的に作り方が違うのでしょうか（あまりこういうものを作ったことがないので）？
作成手順は、
(1)エクセルを開き（Book1新規作成）、Book1のThisWorkBookに教えていただいたマクロを書く
(2)終了してエクセルに戻り、「ファイルメニュー→名前をつけて保存」からxlaで保存
(3)「ツールメニュー→アドイン」から作成したアドインをチェック
の順です。上記手順で作成したアドイン自体のファイルクローズは拾えているのですが、既存ファイルを開き、そのファイルのみクローズする時は拾えないようです。

回答No.3

a269783255

こんな方法ではいかがでしょう？
ブックやエクセルを閉じようとすると、
検索語があればメッセージが出ます。
ＯＫボタンを押すとブックに編集箇所があれば、
「変更を保存しますか？」のメッセージが出ます。
ブックに編集箇所がない場合は、いきなり閉じます。
検索語の追加や変更がしやすいようにと考えてみました。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call test1
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub test1()
On Error GoTo Name
Range("A1").Select
Cells.Find(What:="住所", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
Response = MsgBox("このブックには個人情報が含まれています。", vbOKOnly, "注意")
Exit Sub
Name: Call test2
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub test2()
On Error GoTo Tell
Range("A1").Select
Cells.Find(What:="氏名", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
Response = MsgBox("このブックには個人情報が含まれています。", vbOKOnly, "注意")
Exit Sub
Tell: Call test3
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub test3()
On Error GoTo 閉じる
Range("A1").Select
Cells.Find(What:="電話", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
Response = MsgBox("このブックには個人情報が含まれています。", vbOKOnly, "注意")
Exit Sub
閉じる: Exit Sub
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

お礼

まさにやりたかったことです。とても参考になりました。ところでWorkbook_BeforeCloseは「ファイルメニュー→閉じる」や「ウィンドウを閉じるをクリック」でブックのみ閉じたときのイベントは拾えないのでしょうか？恐縮ですが教えていただけませんでしょうか？

回答No.2

natsuma

Changeイベントで入力時に「注意を促すメッセージ」を出されてはいかがでしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)
If "氏名" = Target.Value Then
MsgBox "注意を促すメッセージ"
End If

If "電話番号" = Target.Value Then
MsgBox "注意を促すメッセージ"
End If

If "住所" <> Target.Value Then Exit Sub
MsgBox "注意を促すメッセージ"
End Sub

お礼

ありがとうございます。参考にさせていただきます。できれば既存ブックを開いて変更がない場合もチェックしたいのですが．．．

回答No.1

a269783255

>ブックを閉じたときにメッセージを出す
という方法はわかりませんが、
閉じようとした時にメッセージを出す。
ならVBAでできそうです。
でも、セルの値を検索させるだけでは、
なにもできませんから、
あった場合にどうしたいのか？
がわからないと、
具体的なアドバイスが受け難いと思います。

補足

早速のお返事ありがとうございます。個人情報保護法施行に伴いブックを閉じようとしたとき、注意を促すメッセージをアドインを利用し、だそうとおもっています。しかしながら全てのブックを対象にするのは、結構うっとおしいので、「電話」とか「名前」とか「住所」といった文字列がファイルのどこかにあった場合のみ注意喚起をだしたいと思っています。いい知恵があればお教えください。