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 · ベストアンサー

お約束のコードです。標準モジュール部

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.10

Wendy02

Wendy02です。

もう一度、最初からやり直しの決定をしました。理由は二つあって、データの出し入れで、データがなくなるのです。（たぶん、UserFormでも行っても同様のトラブルの発生の可能性はあります）　また、イベントの最中に不安定になることに気がつきました。早い話が、個人用マクロブックでも、どこでも同じなのですが、ブックを開く時、閉じる時に、一番加重が掛かるのです。一部のブックのBeforeClose イベントで、開いている部分のモジュールのタイプが、すげ変わってしまうという、致命的なバグがあり解消できません。単に、それを避けるだけなら、エラー・トラップを設ければよいのですが、それは、結果的、どこかでまたエラーが発生する原因になります。私が、「個人用マクロブック」の難しさを書いていた、ひとつなのだと思います。

今までのUserForm の方法でも良いので、それに切り替えようか、昨日夜迷いましたが、今の方針自体は間違っていないと思いなおし、もう少し続けてみようと思います。

そういう私も、この機にExcelというものを勉強しなおしているようなものです。（掲示板で公開してしまったら、何だそんなことかで、おしまいですが、）やはり新しいテクニックを開発しているわけです。小手先のテクニックではどうしようもなく、自分の開発経験の浅さに嘆きつつも、もう少しがんばってみます。お時間掛けてすみません。

お礼

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

No.9でお示しいただいたコードについて、それぞれの命令文がどのような意味を持っているのか、Webで調べたりしています。まだまだわからない部分も多いのですが、とても勉強になります。
わたしなどには到底想像もできないようなハイレベルなマクロをお考えくださっていることと思います。

>お時間掛けてすみません。
とんでもないです。わたしのほうこそなにもできずに申し訳ありません。

回答No.9

Wendy02

こんばんは。Wendy02です。

最初に作ったものは、ボツにしましたので、本日、別な方法でつくり、やっと、今、9割できたようですが、しばらく使って、バグを探している最中です。何年ぶりかで、本格的なものを作ったのです。

しかし、ここの書き込み時に注意がありますが、

#回答は全角800字（半角1600字）以内です。これを超える長文の分割投稿はご遠慮ください。

ここに掲示するためには、そのローカルルールに触れるような気がします。行数で、500行ぐらいになってしまいます。半角文字数換算で、8,000字　ぐらいになってしまうようです。私は、ここのローカルルールに触れそうになるのは、初めてなのです。

本来は、直接、お渡しする内容のようです。
ちょっと、困ってしまいました。やってみるしかありませんね。しょうがありません。

結局、別のブックを使用して書き込みすることにしましたが、いろいろ試してみて、ブックの使用中は、書き込みをしないようにしました。そして、メモリ上にデータを置くのはやめて、必ず、隠しコンボボックス内のリストに置くという方法を立てました。これは、隠し技のひとつになると思います。（EXCELのメモリは不安定で失いやすいからです）

以下が、見える側のコンボボックスです。

　　 Set MyCB = Application.CommandBars("WorkSheet Menu Bar")
　　 cnt = MyCB.Controls.Count　
　'ファイルリスト親メニュー
　Set MyCBCtrl = MyCB.Controls.Add(Type:=msoControlPopup, _
　　　　　 Before:=cnt + 1, Temporary:=True)

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

小出しにするつもりではないのですが、前書きとして、大事な部分を書いておきます。
'-----------------------------------------

'Class1 設定

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 _
　 StrComp(Wb.Name, INI_FILE, vbBinaryCompare) Then
　LatestFileName = Wb.FullName
　Call Item_Add(LatestFileName)
ElseIf StrComp(Wb.Name, INI_FILE, vbBinaryCompare) = 0 And StartFlg = False Then
　Call MakingFileNameLists
End If
End Sub

'---------------------------------------------
'標準モジュール
Public myApp As Class1
Public LatestFileName As String 'Class からの出力
Public StartFlg As Boolean

Sub Auto_Open()
　'起動時の自動実行
　Call SetMyApp
End Sub

Sub SetMyApp()
'起動時のApplicationインスタンス
　StartFlg = True
　Set myApp = New Class1
　Set myApp.App = Application

End Sub

このコードは、ファイルを終了したときに、ファイルの名前が、出力されるためのイベントです。変数の　LatesFileName が出力されます。なお、一部変更する可能性があるのは、StartFlg のブーリアン値を逆にするかもしれません。(以上約1750字)

補足

Wendy02さん
お世話になりましてありがとうございます。
>私は、ここのローカルルールに触れそうになるのは、初めてなのです。
わたしのせいでご迷惑をおかけしまして申し訳ありません。大変な労力を割いていただき、本当になんとお礼を申し上げたらよいかわかりません。

それから、ご報告ですが、No.6でお教えいただいたコードを職場で試してみたところ、Wendy02さんが予想されたとおり、リストを表示してくれませんでした。

わたしがいうのもヘンですが、あまり根を詰めていただいてお体に障るようなことのないよう、お気をつけください。

回答No.8

Wendy02

こんばんは。

最初に、まだ、マクロは出来そうにもありません。

あまり、複雑なものを考えすぎたのかもしれません。「PERSONAL.XLS」に書き込まないで、ログを取ることは、問題はないのですが、そのファイル名の保存とリストとの表示のタイミングが、今、見えてこないのです。たぶん、保存するときが、本来、ベストではないかとは考えて作っているのですが、まだ、書き終わっていないのです。かなりコードが、長文になってしまいました。こういうケースは、いままでなかったのです。今のようなペースだと、だいたい、失敗のケースが多いです。

ただ、今回の事情を聞かせていただき、これは何とかしなくてはいけない、と思いました。中途半端なものではいけないですね。もしかしたら、アドインのほうが良いかもしれません。個人の問題ではないのではないのでしょうから。

>管理者にもきいたのですが、全社的にわざわざそういう設定にしてあるとのことでした（ファイル履歴が使えるとセキュリティ的にどんな不都合があるのかは、面倒だったのか、それとも秘密なのか、説明してもらえませんでしたが）。

自分と会社との立場の関係があるから、それは簡単にはいかないでしょうけれども、akeem2003さんが今おやりになっているような、VBAを動かすことが許可されているなら、はっきり言えば、何とかなります。会社によっては、VBA禁止令が出ているところもありますから。

また、C:\File Programes/C:\Windows フォルダの書き込み、閲覧禁止というところはあります。もしかしたら、IE を殺してあるとか？単に、Office の履歴だけを取れないようにする意味はないので、他の複合的な問題かもしれません。

私は、前回に書いた、「PERSONAL.XLS」に書き込みをしないという原則も、撤回したほうがよいかもしれません。もう、背に腹は変えられないというか。

（事情が分からなかったので、一方的な言い分を書いて、大変申し訳ありません。年に1度のトラブルもないものに、あれこれ言っても、履歴を見れないほうが遥かに問題は大きいです!）いろいろ、思考錯誤してみます。

補足

Wendy02さま

大変お手数をおかけしまして申し訳ありません。ここまで親身になっていただいて、本当にありがたく思っております。おおげさではなく、感激で涙が出そうです。

>C:\File Programes/C:\Windows フォルダの書き込み、閲覧禁止というところはあります。もしかしたら、IE を殺してあるとか？
確かに、c:ドライブは一般ユーザーには閲覧すら許可されていません。IEは、セキュリティ関係の設定をいじれないようにはされていますが、使用はできます。

面倒なことにおつきあいいただき申し訳ありませんが、なにとぞよろしくお願い申し上げます。

回答No.7

Wendy02

こんにちは。

>Excelの ツール－オプション－最近使用したファイルの一覧 というメニューも、グレーになっていて操作できないようにされています。

>何やらセキュリティの関係だとかで、エクスプローラーやオフィスソフトのファイル履歴が表示されないのです。

それは、かなり使いづらいですね。実は、その「グレー」になって操作できない現象が、PERSONAL.XLS か、EXCEL.XLB ファイルの反乱を起こして、「グレー」になることがあるのです。その二つのファイルを削除すると、デフォルトに戻ると同時に、機能は復活するはずなのですが。（PERSONAL.XLS のマクロは、一旦、エクスポートして、新たに作ったPERSONAL.XLS にインポートします）

本当に、「設定されたもの？」か、管理者さんに確認されたほうがよいのではありませんか？エクスプローラはともかくとして、Excelでは、トラブル以外は、そんな話は聞いたことがありません。

それから、私の書いたマクロは、そういう状態では使えないはずです。以前も、似たような相談を受けてだめだった経験があります。

今は、ファイル名は、手書きか何かをされているわけですね。

ファイル名のログを取るマクロというのは、今すぐ出来ませんが、ある程度のイメージはあります。そういう種類のマクロは、半端じゃなく、難しそうです。しばらく考えて、もし、だめだったら、ダメだったという書き込みを入れます。

順を追って、リストのファイル名が下に追いやられるように作らなくてはならないことですね。手動で削除する方法も入れておかなくてはなりません。

補足

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

>本当に、「設定されたもの？」か、管理者さんに確認されたほうがよいのではありませんか？
管理者にもきいたのですが、全社的にわざわざそういう設定にしてあるとのことでした（ファイル履歴が使えるとセキュリティ的にどんな不都合があるのかは、面倒だったのか、それとも秘密なのか、説明してもらえませんでしたが）。同僚達もあきらめて使っています。(;_;)　ファイルの場所は記憶に頼っていますが、さっき使ったファイルでも、上司から急に「○○の資料すぐ出して」などといわれて慌てると、全然わからなくなったりします。

>そういう種類のマクロは、半端じゃなく、難しそうです。
まさかそんなこととは予想もせず、わたしは無謀な挑戦をしていたのですね。冷や汗ものです。

>しばらく考えて、もし、だめだったら、ダメだったという書き込みを入れます。
ご好意に甘えっぱなしでまことに恐縮ですが、なにとぞよろしくお願いいたします。

回答No.6

Wendy02

#4の補足の回答をさせていただきます。

>気のせいか、処理速度が上がったように思います。
人の感知するレベルでの速度は上がっていないはずですが、RowSource の使い方は、少し、イレギュラーかもしれません。トラブルはないとはいえないのですが、アクセスが速いです。

>どこかのWebページで、「PERSONAL.XLSを記録用に使っている」
たぶん、あえて、サイトの場所は示しませんが、私の知っている有名な場所でしたら、そこの内容のレベルは、あまり高くありませんし、直す点がかなりあるようです。PERSONAL.XLS は、主に、Excelのツールボタンのマクロに登録するのが一般的です。

特に、あまりPERSONAL.XLS に詰め込みますと、起動時間が遅くなったり、ツール－オプションのデフォルト設定に影響を受けることがあったり、最悪は、起動しなくなったりします。年に1度あるトラブルでもありませんが、絶対にないトラブルとは言えないのです。理由は、XLSというバイナリ・ファイルの構造そのものに原因があります。

「最近使ったエクセルファイルを記録して、リストボックスで一覧表示し、リストから選んで再びそのファイルを開く」

ご質問のコードとご説明と内容が違うようですし、既存のメニュー－ファイルの中に、その機能はあるとは思います。

既存の機能の中で、

○ツール－オプション－全般－最近使用したファイルの一覧　

で、数を指定することが出来ますから、それで呼び出すだけでよいはずです。

>PERSONAL.XLSを使わない方法、まだちょっと思いつかないのですが、考え方のヒントだけでもお教えいただけないでしょうか。よろしくお願いいたします。

PERSONAL.XLS を使わないというよりも、出し入れを頻繁にしなければよいのです。Excel Applicationを終了したときに、変更の保存を催促されなければよいわけです。

参考までに、以下のような方法でもよいかと思います。イメージ的にはかなり違うかもしれませんが、PERSONAL.XLSには書き込みはしていません。既存の機能から呼び出しています。

ただ、本来は、こういうスタイルの場合、ツールバーやメニューバーに組み込んで、コンボボックス(CommandBarComboBox)にしたほうがよいです。少し、内容が高度になります。今は、便宜的に、UserFormにしてあります。（なお、二つのスタイルを作ってみて、これに決まりました。）

なお、以下は、ListBox1 のMultiSelct 0-fmMultiSelectSingle になっています。ファイルを同時に開けることはありませんから。

Private Sub UserForm_Initialize()
Dim myPath(20, 1)
Dim i As Integer
Dim j As Integer
Dim buf As String
On Error Resume Next
Do While Err.Number = 0
　Err.Clear
　i = i + 1
　j = InStrRev(Application.RecentFiles.Item(i).Name, "\")
　If j > 0 Then
　　buf = Mid$(Application.RecentFiles.Item(i).Name, j + 1)
　Else
　　　 buf = Application.RecentFiles.Item(i).Name
　End If
　myPath(i - 1, 0) = buf 'ファイル名
　myPath(i - 1, 1) = Application.RecentFiles.Item(i).Path
Loop
ListBox1.List = myPath
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim wb As Variant
Dim flg As Boolean
Dim fName As String
Dim i As Integer

　flg = False
　For Each wb In Workbooks
　　If ListBox1.Text = wb.Name Then
　　　MsgBox "すでに" & ListBox1.BoundValue & "は開いています。": Exit Sub
　　End If
　Next wb
　On Error GoTo ErrHandler
　For i = 0 To ListBox1.ListCount - 1
　　If ListBox1.Selected(i) = True Then
　　　fName = ListBox1.List(i, 1)
　　　'ファイルを開く
　　　Workbooks.Open fName
　　End If
　Next i
Exit Sub
ErrHandler:
　MsgBox Err.Number & " :" & Err.Description
End Sub

p.s.私も別のプログラミングの初歩の初歩を勉強していますが、分からないことは、先回しです。先に行けば必ず分かるようになるというのが、VBAを学んだ経験から確信が得られました。1年後かもしれないし、2年後かもしれません。人間は、知らないことは、どうしても知りたいという本能もありますが、それをじっとこらえることも大事かなって思います。（^^;

補足

素晴らしいコードをお考えいただき本当にありがとうございます。１行ずつ読み解いて勉強させていただきます。そのうち、CommandBarComboBoxを使った処理にも挑戦したいと思います。

>ご質問のコードとご説明と内容が違うようです
おっしゃるとおりです。改めて読み返すと、説明になっていませんでした。はじめに書いた「最近使ったエクセルファイルを記録して、リストボックスで一覧表示し、リストから選んで再びそのファイルを開く」の他に、「リスト中不要なファイル名は削除する」ということも考えておりまして、書き込んだコードは、後者の処理のためのものでした。訳のわからないことを書きまして失礼いたしました。

>既存のメニュー－ファイルの中に、その機能はあるとは思います。
私がこのマクロを使いたいと思っているのが、職場のパソコン上においてなのですが、何やらセキュリティの関係だとかで、エクスプローラーやオフィスソフトのファイル履歴が表示されないのです。Excelの ツール－オプション－最近使用したファイルの一覧 というメニューも、グレーになっていて操作できないようにされています。
忙しいときには、昨日（あるいはついさっき）使ったファイルの所在をいちいち探す作業にストレスを感じてしまいますので、なんとか自力で代替の機能を用意できないかと試しているところなのです。No.6でお示しいただいたコードが自宅のExcelと同様に職場でも動くかどうか、確認したいと思います。（うまくいけば最高なのですが…）

それにしても、PERSONAL.XLS を不用意に操作することでExcelが起動しなくなることがあるとは思いもよりませんでした。これからは気をつけます。

回答No.5

Wendy02

>数あるExcelマクロ書籍の中で、基本から今回お教えいただいたようなTipsまで

#4 の私から、お勧めするのは、大村あつし氏の『かんたんプログラミングシリーズのExcel　VBA』（3部）がよろしいと思います。全体的には、細かすぎる傾向があるのと、基礎編が概念的というか、大村氏独特の解釈の仕方は、ある程度、知っているものには、鼻に付くものであり、また、初心者には理解しにくいものがあるかと思います。そういう部分は、無視して良いと思います。しょせん、そんなことは、一回では覚えるわけではありませんし、後々になれば分かります。あまり根をつめて読まなければよいと思います。体系的というよりも、段階的に覚えていくのがよいです。今回の内容は、主に、2部のコントロール編で済みます。3部の応用編の技術は必要ないです。

とにかく、手を動かすこと。入力すること。プロシージャを最低でも500個ぐらい作って、「実行」すれば覚えられます。

本来は、純粋に、VBAから入ると良いのですが、そうすると、独習者は、飽きてしまうような気がします。ただ、そのほうが学習スピードは早いはずです。

参考URL：

http://www.amazon.co.jp/exec/obidos/ASIN/4774120286/

お礼

Wendy02さん

ご推薦ありがとうございます。とてもよさそうな本ですね。これできちんと勉強し直そうと思います。

>あまり根をつめて読まなければよいと思います。

はい。気楽に気長にやっていきます(^^)

回答No.4

Wendy02

こんばんは。

全体的に、コードがヘンです。

データだけを書き入れるなら、少なくとも、myCell は、配列変数だから、その値は、数値か文字列だけです。それを、PERSONAL.XLSに書く必要性はないですね。数千個とか出なければ、最初から、配列関数で配列変数に入れればよいです。

ThisWorkbook.Activate　が、PERSONAL.XLS でないことを信じたいのですが、PERSONAL.XLS を書いたり消したりするのは、誤動作に元になりますから、絶対に、やめたほうがよいです。PERSONAL.XLS は、非表示シートですから、普段、書き入れたり、削除したりはしないようにします。

RowSource をPERSONAL.XLSから取っているのでしょうか？

それを検索して、PERSONAL.XLSのRangeオブジェクトをとってもしょうがないと思います。

Set myCell(i) =

そして、配列変数で宣言してあるのに、ここで、Rangeオブジェクトとして取っているわけです。エラーにはならないけれど、Rangeオブジェクト自体の情報は入らないはずです。

もし、Rangeオブジェクトにするなら、そこは、コレクション変数になるのですが、そんなワザが必要があるとも思えません。ひとつずつ消せばよいのですからね。 以下の場合は、Unionにしてあります。上から取っても、下から取っても、RowSource では、うまくいくとは思えないからです。

>　・セルB2:B21のデータをリストボックスに表示（この部分は別途作成済みです）

だから、それを、Findメソッドで探すこともヘンです。

元のご質問の内容を全部読みきれてはいないのですが、参考までに書かせていただきました。以下は、直接、RowSource でとって、その範囲に対して、行の削除をするようになっています。リストの数が少ないから可能です。

なお、本来は、シートのSelect やActivate なりで、指定したほうが誤って行うことが少ないかとは思います。
'----------------------------------------------------

'ListBox: MultiSelect = 1-fmMultiSelectMulti

Private Sub UserForm_Initialize()
'セルB2:B21のデータをリストボックス
　　ListBox1.RowSource = Range("B2:B21").Address
End Sub

Private Sub CommandButton2_Click()
Dim i As Integer
Dim u As Range
　　Application.ScreenUpdating = False
　　If ListBox1.ListIndex = -1 Then
　　　　Exit Sub
　　End If

　　With ListBox1
　　For i = 0 To .ListCount - 1
　　　If .Selected(i) = True Then
　　　　If u Is Nothing Then
　　　　Set u = Range("B2:B21").Cells(i + 1).EntireRow
　　　　Else
　　　　Set u = Union(u, Range("B2:B21").Cells(i + 1)).EntireRow
　　　　End If
　　　End If
　　Next i
　　End With
　　If Not u Is Nothing Then
　　　　u.Delete
　　End If
　　Application.ScreenUpdating = True
　　Unload Me
End Sub

参考URL：

　

補足

こんばんは。大変丁寧な解説とコードをお示しいただきまして、ありがとうございます。Wendy02さんのコードを試させていただきましたところ、気のせいか、処理速度が上がったように思います。きちんと書かれたコードの力というものでしょうか。

>ThisWorkbook.Activate　が、PERSONAL.XLS でないことを信じたいのですが、

…実は、PERSONAL.XLS を使って、記録や削除を行っています。
そもそも全体的に何をしたいのかをきちんとご説明申し上げていませんでしたが、「最近使ったエクセルファイルを記録して、リストボックスで一覧表示し、リストから選んで再びそのファイルを開く」ということができるようにしようとしています。（Windowsの「最近使ったファイル」が使えないようにされていて、設定の変更もできないためです）

開いたファイル名をもれなく記録していくためには、常に一番最初に開かれるPERSONAL.XLSのThisWorkbookに、自動で起動するマクロを登録しておけばいいのではないかと考え、PERSONAL.XLSを利用することにした次第です。また、どこかのWebページで、「PERSONAL.XLSを記録用に使っている」という記述を見かけたため、そういう使い方もあるのだなと思い、PERSONAL.XLSに書き込みや削除を行っておりました。

>誤動作に元になりますから、絶対に、やめたほうがよいです。

よくわかりました。

PERSONAL.XLSを使わない方法、まだちょっと思いつかないのですが、考え方のヒントだけでもお教えいただけないでしょうか。よろしくお願いいたします。

回答No.3

noname#187541

No.2です。追加です。
行を削除するときは下から削除するのが基本です。
削除すると上に行が移動するので、行がずれて違う行が削除される音になります。

For i = .ListCount -1 To 0 Step -1　とした方がいいでしょう。

補足

>行を削除するときは下から削除するのが基本です。

恐れ入ります(^^;
色々な本やWeb上の情報を拾い読みしているような状態で、基本が身に付いておらず、恥ずかしい限りです。

ここは心を入れ替えて、きちんと体系的に勉強してみようと思います。それで、さらにお尋ねさせていただきたいのですが、数あるExcelマクロ書籍の中で、基本から今回お教えいただいたようなTipsまでを習得できるようなものをご存じないでしょうか。厚かましいお願いですが、お教えいただければ幸いです。

回答No.2

noname#187541

こんばんは。

ListBoxのList設定はRowSourceでやっていませんか?
Listが再設定される(変わると選択が解除されます。
RowSourceでの設定だと、行を削除すると内容が変わるので選択が解除されます。
このために最初の1件しか削除されないのでしょう。

RowSourceをやめてAddItemで設定するといいでしょう。
ただし、Listはそのままなので設定し直す必要があります。

お礼

できました！完璧です！！

ご指摘のとおり、

Private Sub UserForm_Initialize()
UserForm1.ListBox1.RowSource = "B2:B21"
…

とRowSourceでList設定をしていました。その部分を

Private Sub UserForm_Initialize()
For i = 2 To 21
ListBox1.AddItem Cells(i, 2)
Next i
…

と改め、さらに削除処理をするときのカウントの仕方を回答No.3で教えていただいたように直したところ、見事に望みどおりの動きをしてくれるようになりました。ここ数日悩んでいたことが嘘のように解決しました。本当にありがとうございました。

回答No.1

zap35

For i = 0 To .ListCount - 1

ListCountは１オリジン（１から始まる。０は項目がない状態）だったと思うのですが…

For i = 1 To .ListCount
にしたらどうなりますか？

補足

はじめまして。早速のご回答ありがとうございます。

For i = 1 To .ListCount

にしてみたところ、例えばリストの上から１・３・５番目を選んでコマンドボタンをクリックすると、３番目に対応する行が削除され、２・４・６番目を選ぶと、２番目に対応する行が削除されるというように、２番目以降の最初の項目を含む行が削除されるようになりました。よろしくお願いいたします。