For～Nextルーチンで最初の１回しか処理してくれません(Excelマクロ)

ご覧いただきありがとうございます。

Excelで下記のようなマクロを書いたのですが、思ったような処理をしてくれません。色々なWebページや参考書に当たってみましたが、どうしてもわかりません。どの点が間違っているのか、どう直したらよいか、ご教示いただけませんでしょうか。

なお、意図している処理は次のようなものです。
　・セルB2:B21のデータをリストボックスに表示（この部分は別途作成済みです）
　・リストボックスに表示されている項目をユーザーが複数選択する
　・選択後コマンドボタン２をクリックすると、選択された項目を含む行を削除する

以上ですが、選択した項目のうち最初のものだけを削除しただけで終了しています。お手数をおかけいたしますが、よろしくお願いいたします。

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim I As Integer

If ListBox1.ListIndex = -1 Then
MsgBox "選択されていません"
Exit Sub
End If

Dim myStr(19) As Variant
Dim myCell(19) As Variant

With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
MsgBox .List(i)
myStr(i) = .List(i)
Set myCell(i) = Workbooks("PERSONAL.XLS").Sheets(1).Range("B2:B21").Find(myStr(I), , xlValues, xlWhole)
ThisWorkbook.Activate
myCell(i).EntireRow.Delete
End If
Next i
End With

Unload Me
Application.ScreenUpdating = True
End Sub

No.12 ベストアンサー 回答者： Wendy02 回答日時： 2007/04/15 15:47

お約束のコードです。

標準モジュール部

Public myApp As Class1
Public LatestFileName As String 'Class からの出力
Public MyFileName As String
Private WinState As Integer
Private ClearFlg As Boolean
Private Const LIMIT_NUM As Integer = 10
'0:デフォルト,1:ユーザー選択モード,その他:完全固定モード
Public Const FIXEDMODE As Integer = 0
Sub Auto_Open()
Call SetMyApp
End Sub
Sub SetMyApp()
'起動時のApplicationインスタンス
StartFlg = True
Set myApp = New Class1
Set myApp.App = Application
On Error Resume Next
If CommandBars("WorkSheet Menu Bar").Controls("ファイルリスト(&L)").Tag = "" Then
Call CommandMenu_Add
End If
End Sub
Sub CommandMenu_Add()
'メニューの作成
Dim myCB As CommandBar
Dim MyCBCtrl As CommandBarControl
Dim myBtn As CommandBarButton
Dim CBBox1 As CommandBarComboBox
Dim CBBox2 As CommandBarComboBox
Dim cnt As Integer
Set myCB = Application.CommandBars("WorkSheet Menu Bar")
cnt = myCB.Controls.Count

'ファイルリスト親メニュー
Set MyCBCtrl = myCB.Controls.Add(Type:=msoControlPopup, _
Before:=cnt + 1, Temporary:=False)

With MyCBCtrl
.Caption = "ファイルリスト(&L)"
.Tag = "FL"

'ファイルリストボックス
Set CBBox1 = myCB.Controls("ファイルリスト(&L)").Controls.Add( _
Type:=msoControlDropdown, _
Temporary:=False)
With CBBox1
.DropDownWidth = 120 'これら以外は設定できない
.DropDownLines = LIMIT_NUM '行数
.OnAction = "MyFNOpen"
.Visible = True
.Tag = "CB1" '検索のためのタグ設定
End With

'データをストックするコンボボックス
Set CBBox2 = myCB.Controls("ファイルリスト(&L)").Controls.Add( _
Type:=msoControlComboBox, _
Temporary:=False)

With CBBox2
.Tag = "CB2" '検索のためのタグ
.Caption = "CB2"
.Visible = False
End With

'リストの消去メニュー
With myCB.Controls("ファイルリスト(&L)").Controls.Add( _
Type:=msoControlButton, _
Temporary:=False)
.Caption = "リストの編集(&E)"
.OnAction = "ListEdit"
.FaceId = 31

End With
'リストの消去メニュー
With myCB.Controls("ファイルリスト(&L)").Controls.Add( _
Type:=msoControlButton, _
Temporary:=False)
.Caption = "リストの編集終了(&T)"
.OnAction = "ListComplete"
.BeginGroup = False
.FaceId = 11
End With
'リストの消去メニュー
With myCB.Controls("ファイルリスト(&L)").Controls.Add( _
Type:=msoControlButton, _
Temporary:=False)
.Caption = "リストの全消去(&C)"
.OnAction = "ListClear"
.BeginGroup = False
.FaceId = 67
End With
'リストの消去メニュー
With myCB.Controls("ファイルリスト(&L)").Controls.Add( _
Type:=msoControlButton, _
Temporary:=False)
.Caption = "メニューの消去(&M)"
.OnAction = "MenuDelete"
.BeginGroup = False
.FaceId = 459
End With
End With


Set MyCBCtrl = Nothing
Set myCB = Nothing
End Sub
Sub ListClear()
'リストの内容の消去
With CommandBars.FindControl(, , "CB1")
If .ListCount = 0 Then Exit Sub
If MsgBox("リストをすべて消してよろしいですか？", vbOKCancel) = vbCancel Then
Exit Sub
Else
.Clear
End If
End With
With CommandBars.FindControl(, , "CB2")
.Clear
End With
End Sub
Sub CommandMenu_Delete()
'メニューの削除(単独の予備マクロ）
On Error Resume Next
With Application.CommandBars("WorkSheet Menu Bar")
.Controls("ファイルリスト(&L)").Delete
End With
On Error GoTo 0

End Sub
Sub Item_Add(LatestFileName As String)
Dim i As Integer
Dim n As Integer
Dim Arbuf() As String
Dim iMax As Integer
Dim CBBox1 As CommandBarComboBox
Dim CBBox2 As CommandBarComboBox
Set CBBox1 = CommandBars.FindControl(, , "CB1")
Set CBBox2 = CommandBars.FindControl(, , "CB2")
If CBBox1 Is Nothing Then Exit Sub
If CBBox2 Is Nothing Then Exit Sub

n = FindItem(LatestFileName)
If CBBox2.ListCount = 0 Then
CBBox2.AddItem LatestFileName
CBBox1.AddItem Full2FName(LatestFileName)
Exit Sub
End If
While (FindItem(LatestFileName) > 0)
n = FindItem(LatestFileName)
CBBox2.RemoveItem n
Wend
If CBBox2.ListCount >= LIMIT_NUM - 1 Then
iMax = LIMIT_NUM - 1
Else
iMax = CBBox2.ListCount
End If
ReDim Arbuf(iMax) '添え字0があるのでひとつ増える
For i = 1 To iMax
If CBBox2.ListCount >= i Then
If CBBox2.List(i) <> "" Then
Arbuf(i) = CBBox2.List(i)
End If
End If
Next
Arbuf(0) = LatestFileName
CBBox1.Clear
CBBox2.Clear
For i = 0 To iMax
If Arbuf(i) <> "" Then
CBBox1.AddItem Full2FName(Arbuf(i))
CBBox2.AddItem Arbuf(i)
End If
Next
LatestFileName = ""
End Sub
Sub Item_AddOpt(LatestFileName As String)
'ユーザー選択用
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim k As Integer
Dim Arbuf() As String
Dim Arstock() As String
Dim iMax As Integer
Dim CBBox1 As CommandBarComboBox
Dim CBBox2 As CommandBarComboBox
Dim strTop As String
Set CBBox1 = CommandBars.FindControl(, , "CB1")
Set CBBox2 = CommandBars.FindControl(, , "CB2")
If CBBox1 Is Nothing Then Exit Sub 'エラー処理
If CBBox2 Is Nothing Then Exit Sub

n = FindItem(LatestFileName)
If CBBox2.ListCount = 0 Then
CBBox2.AddItem LatestFileName
CBBox1.AddItem Full2FName(LatestFileName)
Exit Sub
End If
While (FindItem(LatestFileName) > 0)
n = FindItem(LatestFileName)
CBBox2.RemoveItem n
Wend
For i = 1 To CBBox1.ListCount
If Left(CBBox1.List(i), 1) Like "[#&$]" Then '特別な印
ReDim Preserve Arstock(1, k)
On Error Resume Next
Arstock(1, k) = CBBox2.List(i)
Arstock(0, k) = CBBox1.List(i)
CBBox2.List(i) = ""
On Error GoTo 0
k = k + 1 '固定ファイル名ストック
If strTop = "" Then strTop = Left$(CBBox1.List(i), 1)
End If
Next i

If CBBox2.ListCount >= LIMIT_NUM - 1 Then
iMax = LIMIT_NUM - 1 - k
Else
iMax = CBBox2.ListCount - k
End If
ReDim Arbuf(iMax) '添え字0があるのでひとつ増える
For i = 1 To iMax
If CBBox2.ListCount >= i Then
If CBBox2.List(i) <> "" And Not (CBBox1.List(i) Like "[#&$]") Then
Arbuf(i) = CBBox2.List(i)
End If
End If
Next
If LatestFileName <> "" Then
Arbuf(0) = LatestFileName
End If
CBBox1.Clear
CBBox2.Clear
For i = 0 To iMax
If Arbuf(i) <> "" Then
CBBox1.AddItem Full2FName(Arbuf(i))
CBBox2.AddItem Arbuf(i)
End If
Next
If k > 0 Then
For j = 0 To UBound(Arstock(), 2)
If Arstock(1, j) <> "" Then
CBBox2.AddItem Arstock(1, j)
CBBox1.AddItem Arstock(0, j)
End If
Next
End If
LatestFileName = ""
End Sub
Private Sub MyFNOpen()
'コマンドメニューリストの選択によって開かれる
Dim CBBox1 As CommandBarComboBox
Dim CBBox2 As CommandBarComboBox
Dim ng As Boolean 'ファイルがない場合
Dim i As Integer
Set CBBox1 = CommandBars.FindControl(, , "CB1")
Set CBBox2 = CommandBars.FindControl(, , "CB2")
With CBBox1
i = .ListIndex
If CBBox2.List(i) <> "" Then
sFNOpen CBBox1.List(i), ng 'ファイルオープン
If ng Then
CBBox1.List(i) = "*" & CBBox1.List(i)
CBBox2.List(i) = ""
End If
End If
.ListIndex = 0
End With
End Sub
Private Sub sFNOpen(fn As String, ng As Boolean)
Dim Wb As Variant
'ファイルを開けるサブルーチン
On Error GoTo EndLine
For Each Wb In Workbooks
If Wb.Name Like fn Then
Wb.Activate
Exit Sub
End If
Next Wb
ng = False
If Len(Dir(fn)) > 0 Then
Workbooks.Open (fn)
Else
ng = True
End If
EndLine:
On Error GoTo 0
End Sub
Sub ListEdit()
'新規ファイルリストブック作成
Dim MyFile As Workbook
Dim Sh As Worksheet
Dim DefShCnt As Integer 'DefaultSheetCount
Dim CBBox1 As CommandBarComboBox
Dim CBBox2 As CommandBarComboBox
Dim WinState As Integer
Dim i As Integer
DefShCnt = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set MyFile = Workbooks.Add
If Len(Dir(MyFile.FullName)) > 0 Then
If MsgBox("バックアップログが残っています。使用しますか？", vbOKCancel) = vbOK Then
GoTo EndLine
End If
End If
Application.SheetsInNewWorkbook = DefShCnt
WinState = ActiveWindow.WindowState
With MyFile.Windows(1)
.WindowState = xlNormal
.Width = 200
.Height = 450 'ウィンドウの高さ
'.Caption = "リストの再編成"
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = False
.DisplayWorkbookTabs = False
.ActiveSheet.Columns(1).ColumnWidth = 8
.ActiveSheet.Columns(2).ColumnWidth = 45
.ActiveSheet.Rows("1:40").RowHeight = 15
End With
If ClearFlg = False Then
Application.Caption = ""
Application.Caption = "リスト編集中"
End If
Set Sh = MyFile.ActiveSheet
MyFile.Protect Windows:=True
Sh.ScrollArea = "A1:C100" 'スクロールロック
For i = 1 To LIMIT_NUM
With Sh.OLEObjects.Add( _
ClassType:="Forms.CheckBox.1", _
Link:=False, _
Left:=Sh.Cells(i, 1).Left + 15, _
Top:=Sh.Cells(i, 1).Top + 1, _
Width:=Sh.Cells(i, 1).Width * 2 / 3, _
Height:=Sh.Cells(i, 1).Height _
)
.Visible = True
.Object.Caption = ""
End With
Next i
Sh.Cells(i + 2, 2).Value = "不要なものはチェック"
Sh.Cells(i + 3, 2).Value = "オフにしてください"
Sh.Cells(i + 4, 2).Value = "リスト編集終了で"
Sh.Cells(i + 5, 2).Value = "終了してください。"


Set CBBox1 = CommandBars.FindControl(, , "CB1")
Set CBBox2 = CommandBars.FindControl(, , "CB2")
For i = 1 To CBBox1.ListCount
If i <= LIMIT_NUM Then
Sh.Cells(i, 2).Value = CBBox1.List(i)
Sh.Cells(i, 4).Value = CBBox2.List(i)
Sh.OLEObjects("CheckBox" & i).Object.Value = True
End If
Next
Application.DisplayAlerts = False
MyFile.SaveAs "MyFileList"
If ClearFlg = True Then
MyFile.Close False
End If
Application.DisplayAlerts = True
Set Sh = Nothing
EndLine:
Set MyFile = Nothing
End Sub
Sub ListComplete()
'リストの終了時
Dim MyFile As Workbook
Dim Sh As Worksheet
Dim CBBox1 As CommandBarComboBox
Dim CBBox2 As CommandBarComboBox
Dim buf1() As String
Dim buf2() As String
Dim i As Integer
Dim j As Integer
Dim e As Integer
Dim n As Integer
On Error GoTo ErrHandler
Set MyFile = Workbooks("MyFileList.xls")
MyFileName = MyFile.FullName
Set Sh = MyFile.Sheets(1)
With Sh
For i = 1 To LIMIT_NUM
If .OLEObjects("CheckBox" & i).Object.Value = True Then
'データがあっても、行がなければ最終的には取り込まれない
ReDim Preserve buf1(j)
ReDim Preserve buf2(j)
buf1(j) = Sh.Cells(i, 2).Value
buf2(j) = Sh.Cells(i, 4).Value
j = j + 1
End If
Next i
End With
Set CBBox1 = CommandBars.FindControl(, , "CB1")
Set CBBox2 = CommandBars.FindControl(, , "CB2")

CBBox1.Clear
CBBox2.Clear
On Error Resume Next
i = UBound(buf1)
If Err.Number = 0 Then
For j = LBound(buf1) To UBound(buf1)
If Err.Number = 0 Then
CBBox1.AddItem buf1(j)
CBBox2.AddItem buf2(j)
End If
Next j
End If
Application.Caption = ""
Application.EnableEvents = False
MyFile.Close False
Application.EnableEvents = True
Kill MyFileName
Set Sh = Nothing
Set MyFile = Nothing
If WinState <> 0 Then
ActiveWindow.WindowState = WinState
End If

ErrHandler:
If Err.Number <> 9 And Err.Number > 0 Then '9は、ブックがない
MsgBox Err.Description
End If
End Sub
Sub MenuDelete()
Dim myMenu As CommandBarControl
'Menuの消去
On Error Resume Next
Set myMenu = CommandBars("WorkSheet Menu Bar").Controls("ファイルリスト(&L)")
If Not myMenu Is Nothing Then
If MsgBox("メニューを消去するとリストもなくります。" & vbCrLf & _
"よろしいですか?", vbOKCancel) = vbOK Then
Application.ScreenUpdating = False
ClearFlg = True
Call ListEdit
Application.ScreenUpdating = True
myMenu.Delete
End If
End If
On Error GoTo 0
End Sub

'===========ユーザー定義関数===============================
Function FindItem(fn As String) As Integer
Dim flg As Boolean
Dim CBBox2 As CommandBarComboBox
Set CBBox2 = CommandBars.FindControl(, , "CB2")
If CBBox2 Is Nothing Then Exit Function
For i = 1 To CBBox2.ListCount
If StrComp(fn, CBBox2.List(i), 1) = 0 Then
Exit For
End If
Next i
If CBBox2.ListCount < i Then
i = 0
End If
FindItem = i
End Function
Function Full2FName(fn As String)
Dim buf As String
k = InStrRev(fn, "\")
If k > 0 Then
buf = Mid$(fn, k + 1)
Else
buf = fn
End If
Full2FName = buf
End Function

No.21 回答者： Wendy02 回答日時： 2007/04/27 00:26

akeem2003　様

こんばんは。Wendy02です。

まだ、少し、気になっている部分はありますが、今後は、akeem2003　様のほうが、今度は、私とバトンタッチしてくださるように期待しています。最初は、すごいなって思っているコードでも、１年経ち、２年経つと、あのときは、すごいと思ったものも、それほどではないなっていうことが多いものです。個々のプロシージャーは、それほど難しいコードは書いていないはずです。ここまできて、どうやら、お叱りを受けずに削除されなかったようでホッとしているというのが、正直な気持ちです。

久々で、良い経験をしました。

今更ですが、UserFormをお使いになっていたものとは、内容的にも違いますので、本当に良かったか、少し、気をとがめています。実は、うまくいかなくて、途中であきらめかけたのです。また、本来は、メニューのファイル(F)の中にもぐりこませることも可能でしたが、そういう確認もしませんでした。ただ、今、私のほうも、同じマクロを使い続けていますが、問題はなく働いています。(Excel2003)

また、私は、hta ファイル（WSHのメニューファイル）で、Excelの特定のファイルを開けるようなこともしております。こういう方法は、今回は紹介しませんでした。

今、VBAは、端境期にあるので勉強しずらくなっています。私がVBA/VBの書籍を、オークションでDeveloper 版などの参考本を集めていたのは昨年です。いまさら、VB6 の勉強などはお勧めしませんし、かといって、VB.Net(VB2005)では、あまりに違いすぎます。ただ、当分（5～6年ぐらい）は、VBAは残りそうな気もしますが、今後、私は、VBA自体が蚊帳の外に置かれるのではないか、と思っています。そうすると、多くの、MS-Officeのマクロプログラマとしては、あきらめていくのではないか、なんて想像したりしています。今、現在、MS-Office は、ちゃくちゃくと、COMアドイン化の方向にありますから、COMアドインでなければ、アドインにはあらず、というような風潮が強くなるかと思います。

なお、私の教科書的に使っているのは、『Microsoft Office 97 プログラマーズガイド』マイクロソフトKK （ほとんど手に入りませんが、これに匹敵する本は、ひとつもありません。MSの文章がまともだった頃の書籍です。）似たような書名で『Excel2000のプログラマーズガイド』というのは、まったく内容は別です。

もうひとつは、#5 で紹介していた後になる書籍で、井川はるき氏の『Excel VBAプロの技』ナツメ社-プロと書かれていますが、内容的には中級レベルです。一通り学んだ人が、おさらいしたり、知識の補充したりするのにはちょうどよいレベルです。文章が練りこんでいないので、読みにくいのが難点です。

私は、今、VBAから別の本格的な言語の勉強をし始めています。いつになったら覚えるかは分かりませんが、いつまでも、勉強はしていくつもりです。

この回答へのお礼

>今後は、akeem2003　様のほうが、今度は、私とバトンタッチしてくださるように期待しています。
おそれおおいお言葉です。他の質問へのご回答を拝見しますと、とてもWendy02様の域には達せそうにありませんが、目標は高く持ってがんばろうと思います。#21でお教えいただいた書籍も探してみます。

>今更ですが、UserFormをお使いになっていたものとは、内容的にも違いますので、本当に良かったか、少し、気をとがめています。
とんでもないです。ユーザーフォームを使ったのは、他の方法を思いつかなかったためで、いまのかたちのほうが格段にスマートで、大満足です。お作りくださったマクロが実際動いたときは、とても興奮しました。

今はまだ、簡単なコードを書くにも一日費やしたりするようなレベルですが、いつかは、他の人に使ってもらえるようなマクロを作れるようになりたいと思っています。

お礼日時：2007/04/27 01:01

No.20 回答者： Wendy02 回答日時： 2007/04/26 18:56

こんばんは。

昨日は、うっかりしていました。一旦出来上がってしまうと、なかなかいじれないものなのです。

アドイン化して、試してみました。
以下の程度で十分だと思います。

すでに出来上がってしまったものにでは、以下のようなコメントは出てこないとは思います。

配布用には、おそらく、「ファイルの履歴を記録するアドイン」というものが出てくるかと思います。出来れば、プロパティのコメントにも、このような内容とか、日付とか入れたいところです。

それから、プロジェクトには、簡単なプロテクトを付けておくとよいです。
忘れてもよいように、誰でもわかるようなパスワードをしておくと、Classのインスタンスを壊されないですみます。アドインを外すときには、メッセージが出てきます。

ややこしいプロテクトのパスワードはよくありませんが、何もないのも良くありません。

ファイルを削除してしまった場合のトラブルもあるかもしれません。その時は、単独で、MenuDelete のマクロを実行させると消せます。

'ThisWorkbook モジュール

Private Sub Workbook_AddinInstall()
　Call SetMyApp
　Application.MacroOptions Macro:="CommandMenu_Add()", _
　　　　　　　　Description:="ファイルの履歴を記録するアドイン"
End Sub
Private Sub Workbook_AddinUninstall()
　Call MenuDelete
End Sub

なお、不明なファイル名が出てくるのは、何が原因か分かりません。開かないので、* がつきました。長い間には、何かあるかもしれませんが、その時は、また、その時に考えるしかありません。出来れば、コンパイル型のアドインに換えることが出来れはよいですが。

この回答へのお礼

こんばんは、丁寧なご説明ありがとうございます。お示しくださったコードを追加して、パスワードで保護したアドインファイルを、正式版として配布させていただくようにします。すでに職場で試用してもらっているマクロも、大変好評です。

今回の質問は、これで締切とさせていただきたいと思います。ご親切ほんとうにありがとうございました。いくらお礼を申し上げても足りません。今回ご指導いただいた内容は、わたしの宝物です。永久保存して、もっともっと勉強させていただきます。

今後また、マクロのことなどでご質問させていただくことがあると思います。そのときはどうかよろしくお願いいたします。

お礼日時：2007/04/26 23:11

No.19 回答者： Wendy02 回答日時： 2007/04/26 01:40

こんばんは。

>アドインが動いている間は標準のメニューバーを非表示にしておくものだと思うのですが（間違っているでしょうか）

いいえ、そのメニュー[ファイルリスト(&L)]のみが、非表示です。
しかし、良くみると、良く考えずに書いてしまいましたので、アドインとして意図するものが、違ってしまっていました。本日は遅いので、明日ぐらいに訂正したものを出します。

すみません。

>このコードなしでアドイン化した場合、動作上どのような不具合が生じる可能性があるのでしょうか。非常に興味があります。

中身を良く見ていませんでした。自分の個人用マクロから抜き出しただけで、そのマクロは何も働きません。（^^;
　

No.18 回答者： Wendy02 回答日時： 2007/04/25 21:44

こんばんは。

アドインの作り方ですが、私自身が、非コンパイル型のプログラムはあまり追わないことにしていることと、一般公開用の本格的なアドインは作ったことがありません。簡易インストーラを使うだけです。それで十分だと思っています。

簡易インストーラ
http://www.webtech.co.jp/onlinesoft/exepress/ind …
（ただし、今調べたら、旧バージョンは、手に入らないようです。Win 2000以上　これは、CABファイルから作ります。）

資料は、MSのプログラマーズガイドにしかなく、インターネットでもほとんど出ていません。（ここのカテゴリでも何年もきちんとしたものは１度も出たことはありません。かなりいい加減に教える人がいます。）

ところで、基本的なアドインのお約束ですが、ThisWorkbook を以下のようにしてあげると良いです。専門的にするには、まだ、ほかにも約束めいたものがあります。約束めいたものを無視しても、そんなに問題はありません。

それから、こうしなければならない、というものではありません。

'ThisWorkbook モジュール

Private Sub Workbook_AddinInstall()
　On Error Resume Next
With Application.CommandBars("WorkSheet Menu Bar").Controls("ファイルリスト(&L)")
　.Controls(2).Visible = False
End With
End Sub

Private Sub Workbook_AddinUninstall()
　On Error Resume Next
With CommandBars("WorkSheet Menu Bar").Controls("ファイルリスト(&L)")
　.Controls(2).Visible = True
End With
End Sub


Private Sub Workbook_Open()
　On Error Resume Next
With Application.CommandBars("WorkSheet Menu Bar").Controls("ファイルリスト(&L)")
　.Controls(2).Visible = False
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　On Error Resume Next
With CommandBars("WorkSheet Menu Bar").Controls("ファイルリスト(&L)")
　.Controls(2).Visible = True
End With
End Sub

資料：

http://msdn.microsoft.com/library/ja/modcore/htm …
Excel アドイン

http://msdn.microsoft.com/library/ja/modcore/htm …
Office アプリケーション固有のアドインの配置

この回答への補足

こんばんは、大変お世話になりましてありがとうございます。

お教えいただいた簡易インストーラを試してみました。これを使ってアドインソフトを実行形式にして相手に渡せば、そのファイルをクリックしてもらうだけで、あとは簡易インストーラがインストール作業のガイドをしてくれるということですね。アドイン形式のまま配布するよりも、使う人が戸惑うことが少なくなると思います。大変助かりました。ありがとうございます。

もうひとつだけお教えください。今回お示しくださった、ThisWorkbookに記述するコードは、アドインが動いている間は標準のメニューバーを非表示にしておくものだと思うのですが（間違っているでしょうか）、このコードなしでアドイン化した場合、動作上どのような不具合が生じる可能性があるのでしょうか。非常に興味があります。よろしくご教示をお願いいたします。

補足日時：2007/04/26 00:47

No.17 回答者： Wendy02 回答日時： 2007/04/20 12:14

こんにちは。

その日(4/17 23:54)に書いたはずなのに、今、みたら、私の書いた内容が登録されていませんでした。すみません。

消えてしまうためミスは、以下を直せばよいです。

Private Sub MyFNOpen()

×sFNOpen CBBox1.List(i), ng 'ファイルオープン
　　　↓
sFNOpen CBBox2.List(i), ng 'ファイルオープン　rev070417

この回答へのお礼

こんばんは。大変お世話になります。

お教えいただいた部分を変更し、完璧に動くようになりました！職場のExcelでも動きました。素晴らしいマクロを作成していただいたおかげで、これからは深い階層のファイルを探し回るという不毛な作業から解放されます。本当にどのようにお礼を申し上げたらよいかわかりません。

>配布をお考えの場合は、アドイン型のほうがよいです。アドイン型は、ThisWorkbookに、少し、手を加えなくてはならないことがあります。

Wendy02さんがおっしゃるように、職場の人たちに広く使ってもらうにはアドイン型にするほうが適していると思いまして、帰宅してからアドイン形式にしてみました。

アドインについては、他の質問者の方にWendy02さんが回答された内容や、Web上の色々な情報を読んでみました。正直よくわからない部分が多く、結局、「ThisWorkbookを修正しないとエラーになるのでは？」とおっかなびっくりでxla形式として保存したのですが、自宅のExcel上では動いてくれています。

月曜日はまた出張のため、火曜日に職場の人にアドインを使ってもらって、動作を確認したいと思っています。万一、職場の環境でエラーが出るようなことがありましたら、またご質問させていただくかもしれません（もちろん、自分でわかるところまでは、調べたり実験したりいたします）。その際にはどうかよろしくお願いいたします。

お礼日時：2007/04/21 01:39

No.16 回答者： Wendy02 回答日時： 2007/04/17 23:20

こんばんは。

Wendy02です。

今、こちらでも、同様の現象を確認しました。
なぜか、下位フォルダのもののパスが消えていますね。ちょっと調べてみます。標準パス以外のフォルダの構成の違う部分では、消えてしまうようですね。

そのまま、ファイルパスを採っているなら、問題はなかったのだろうと思いますが、特別な仕組みをさせていることが、逆に原因となっているようです。ほかにも、少し気になる点があります。

全体を直すことはないと思いますが、少し、お時間ください。

この回答へのお礼

本当にお手数をおかけしまして恐縮です。よろしくお願いいたします。

お礼日時：2007/04/18 01:26

No.15 回答者： Wendy02 回答日時： 2007/04/16 18:18

こんばんは。

Wendy02です。

ブレークポイントでとまらないのは、インスタンスが出来ていないのです。
というよりは、

マクロをいじった後は、必ず
SetMyApp

を実行してください。後は、放っておけば、インスタンスがなくなる恐れは、ハングした以外はありません。1年以上同じスタイルのマクロを使っていますが、そこをいじらない限りは、実行できなかったことはありません。

#14 wendy>次に、リストの編集で、B列がファイル名で、ファイルのフルパスが来ていれば、C列に出てきます。(←間違い）

>B1にファイル名、C1は空白、D1にフルパスが入っていました。

前回の書き込み間違えました。D列にフルパスが入っているので、正解です。

というよりも、それが出来ていれば、もうきちんと動いているはずですね。（^^;
「*」は、開こうとして、エラーが出ているわけです。

この回答への補足

こんばんは。大変お世話になりましてありがとうございます。出張から戻ってから色々試してみたところ、再読込される場合とされない場合があることがわかりました。

どうもファイルの置き場所によって動作が違ってくるようです。My Documentsフォルダにおいたファイルは開いてくれるのですが、同じファイルをMy Documents以外のフォルダ（上位・下位を問わず）に置くと開きません（フォルダ構成は、E:\namae\My Documents\... となっています）。

No.13で、ファイルが開きませんと書き込みましたが、普段、エクセルで作ったファイルはMy Documentsフォルダの下位フォルダに保存しているため、いくら試しても開かれなかったものと思われます。

何かわかるかとコードを見てみましたが、（当然といいましょうか）挫折してしまいました。Wendy02さんでしたらきっと原因がお分かりになられると思いますが、どういう理由によるものでしょうか。よろしくお願いいたします。

補足日時：2007/04/17 23:00

No.14 回答者： Wendy02 回答日時： 2007/04/16 01:08

こんばんは。

それで、もし、変だなと思ったら、

Private Sub NewApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
・
・

InStr(1, Wb.Name, "MyFileList", vbTextCompare) = 0 Then
●→　LatestFileName = Wb.FullName　　【ここに、ブレークポイント】をおく
If FIXEDMODE = 0 Then '通常モード

この部分に、ブレークポイントを入れてください。
（VBEditor の左の淵をクリックすると、●がつきます）
それで、そこで、マクロがとまるか実験してみてください。

操作、実験中は、Class で設定されたインスタンスが壊れやすいので、完成したら、なるべく触らないようにしたほうがよいです。

次に、リストの編集で、B列がファイル名で、ファイルのフルパスが来ていれば、C列に出てきます。


(1)
「*」については詳しくは書いていなかったのですが、ファイル名に「*」がついた場合は、それは開けなかったという意味です。それに関しては、フルファイルパスのデータは消してあります。二度目には、消えてしまいます。


(2) ところてん式に消えるのは、

標準モジュール
'0:デフォルト,1:ユーザー選択モード,その他:完全固定モード
Public Const FIXEDMODE As Integer = 0

が、0 になっていれば、10個を超えるとところてん式に古いものから消えていくようになっているはずです。

(3) 検索タグについて、
>>自分で加工したり調べたりするときに、ひじょうに便利です。
>とお書きいただきましたが、どのように用いればよろしいのでしょうか。

Set CBBox1 = CommandBars.FindControl(, , "CB1")
Set CBBox2 = CommandBars.FindControl(, , "CB2")

これで、オブジェクトが取れます。本来は、そのオブジェクトを取得するために、コンテナから、プロパティまでのコードが必要ですが、CommandBarsのところからダイレクトで、そのオブジェクトを取得できます。ある程度は、ローカルウィンドウでも閲覧できますが、その内容のItem に関しては、

一旦、マクロで、
For i =1 to CBBox1.ListCount
　MsgBox CBBox1.List(i)
'Debug.Print i ; CBBox1.List(i)
Next i

とするか、配列変数に入れてあげないと、中身までは見れません。

この回答への補足

Wendy02様

詳しいご説明ありがとうございます。ご指示に従ってブレークポイントを入れて試してみたところ、途中でマクロが止まることはありませんでした。また、「リストの編集」でMyFileList.xlsを表示してみますと、B1にファイル名、C1は空白、D1にフルパスが入っていました。このようなご報告でお役に立つでしょうか？

（大変申し訳ありませんが、今日から出張に行くため、ご指導いただいても結果をご報告させていただけるのは17日の夜以降になるかもしれません。なにとぞご容赦ください）

補足日時：2007/04/16 02:05

No.13 回答者： Wendy02 回答日時： 2007/04/15 16:03

こんにちは。

以下は、Class モジュール分です。
なんとか、唯一約束は守れそうです。（その代わり、一ヶ月も前の人たちの分は、そのままになってしまいました。他の人は憤慨しているかもしれません。その人たちには、お詫びのしようがありません。）

現在、デフォルトモードはきちんと動くのですが、ユーザー選択モードが、いまひとつ不安定です。もちろん、私の使っているブックは、ものすごく特殊で、起動するとインターネットの設定を変えてしまうような造りのものがあります。そういうものを使ってるせいか、その選択モードが調子が悪いです。（私の書いた、このコードは、まったく、そのような内容のものはありません。ご安心ください）今後、Sub Item_AddOpt　というマクロだけは、手直しが必要な気がします。エラートラップでしのいであります。

ご自身で、試される場合は、やはり、ツールバー側のコンボボックスでないと、いけないようです。私は、最初、ユーザーフォーム上で、スモールサンプルを作ってやってみたのですが、簡単なコードでも、ツールバー上では、初期値などの違いからエラーが発生して、逆に混乱してしまいました。

ユーザー選択モードは、編集の際に、# などをファイル名の最初に入れることで可能です。
後、以下でも分かるように、Book1, Book2 というようなデフォルト名は、記録はされません。例：abc.xls →　#abc.xls とすると、そのファイル名は更新されないというようにしてあります。モジュールは、ひとつ別に作ってください。混在させないようにしたほうがよいです。また、モジュールをいじると、インスタンスが壊れて、記録をしなくなります。
インスタンスを復活させるには、SetMyApp　というマクロを実行すればよいです。
通常は、壊れることはありません。また、他のClass を設定するマクロと混在すると片方が壊れることがあります。その場合は、マクロを統合するとよいです。ただし、Class は、別々のほうが安全です。



Private WithEvents NewApp As Application
Public Property Set App(ByVal myApp As Application)
'カプセル化
Set NewApp = myApp
End Property


Private Sub NewApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
If ThisWorkbook.Name <> Wb.Name And _
Not (Wb.Name Like "Book#*") And _
Wb.IsAddin = False And _
InStr(1, Wb.Name, "MyFileList", vbTextCompare) = 0 Then
LatestFileName = Wb.FullName
If FIXEDMODE = 0 Then '通常モード
Call Item_Add(LatestFileName)
ElseIf FIXEDMODE = 1 Then '選択モード
Call Item_AddOpt(LatestFileName)
End If
ElseIf StrComp(Wb.FullName, MyFileName, vbBinaryCompare) = 0 Then
Call ListComplete

End If
End Sub


Private Sub NewApp_WorkbookOpen(ByVal Wb As Workbook)
Call SetMyApp
End Sub

この回答への補足

ありがとうございます！！アイコンまで表示されて、もともとExcelに備わっている機能かと思うような素晴らしい出来栄えですね！マクロでこういうことまでできるのですね。このような大作をお作りいただき、なんとお礼を申し上げたらよいかわかりません。
わたしにはまだまだ難しすぎますが、コードを勉強させていただいて、色々なテクニックやアイディアを身につけたいと思っています。

多くの方の質問にご回答していらっしゃるWendy02さんを独占させていただくことになり、他の質問者の方にも申し訳ないですが、もう少しお教えください。

１）コンボボックスに表示されるファイル名をクリックしても、そのファイルが開かれないのですが、マクロの登録先を間違ったりしているのでしょうか（No.13の部分はPERSONAL.XLSのクラスモジュールとして登録し、No.12の部分はPERSONAL.XLSの標準モジュールとして登録しました）
ファイル名をクリックすると、メニューが折り畳まれて、「ファイルリスト(L)」という状態に戻ります。もう一度「ファイルリスト(L)」をクリックしてみると、ファイル名に*がついた状態に変化していますが、やはり開くことができません。

２）また、No.12で予告していただいていました、
>開けられなかったファイルは、[*]がついて、おそらく次回には消えてしまうはず
という部分について、正しく理解できていなかったために、その時点で仕様の変更をお願いしていなかったのですが、ファイル名は消えずに残っていき、10個を超えるとところてん式に古いものから消えていく、という処理にしたい場合、どのようにすればよろしいでしょうか（これ以上お手間をおかけするわけにまいりませんので、ヒントだけでもお示しいただければと思っております）

３）検索タグについて、No.11で
>自分で加工したり調べたりするときに、ひじょうに便利です。
とお書きいただきましたが、どのように用いればよろしいのでしょうか。

以上、重ね重ね恐縮ですが、ご教示よろしくお願いいたします。

補足日時：2007/04/15 23:05