こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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

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

投稿日時 - 2007-04-06 21:32:03

QNo.2899966

困ってます

質問者が選んだベストアンサー

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

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

投稿日時 - 2007-04-15 15:47:27

ANo.12

このQ&Aは役に立ちましたか?

15人が「このQ&Aが役に立った」と投票しています

回答(21)

ANo.21

akeem2003 様
こんばんは。Wendy02です。

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

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

今更ですが、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から別の本格的な言語の勉強をし始めています。いつになったら覚えるかは分かりませんが、いつまでも、勉強はしていくつもりです。

投稿日時 - 2007-04-27 00:26:47

お礼

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

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

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

投稿日時 - 2007-04-27 01:01:14

ANo.20

こんばんは。

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

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

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

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

それから、プロジェクトには、簡単なプロテクトを付けておくとよいです。
忘れてもよいように、誰でもわかるようなパスワードをしておくと、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 18:56:19

お礼

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

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

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

投稿日時 - 2007-04-26 23:11:13

ANo.19

こんばんは。

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

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

すみません。

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

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

投稿日時 - 2007-04-26 01:40:30

ANo.18

こんばんは。

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

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

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

ところで、基本的なアドインのお約束ですが、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/html/deovrexceladdins.asp
Excel アドイン

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

投稿日時 - 2007-04-25 21:44:17

補足

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

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

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

投稿日時 - 2007-04-26 00:47:37

ANo.17

こんにちは。

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

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

Private Sub MyFNOpen()

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

投稿日時 - 2007-04-20 12:14:22

お礼

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

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

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

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

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

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

投稿日時 - 2007-04-21 01:39:17

ANo.16

こんばんは。Wendy02です。

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

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

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

投稿日時 - 2007-04-17 23:20:58

お礼

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

投稿日時 - 2007-04-18 01:26:46

ANo.15

こんばんは。Wendy02です。

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

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

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

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

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

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

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

投稿日時 - 2007-04-16 18:18:55

補足

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

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

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

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

投稿日時 - 2007-04-17 23:00:30

ANo.14

こんばんは。

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

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

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

投稿日時 - 2007-04-16 01:08:07

補足

Wendy02様

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

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

投稿日時 - 2007-04-16 02:05:59

ANo.13

こんにちは。

以下は、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

投稿日時 - 2007-04-15 16:03:34

補足

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

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

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

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

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

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

投稿日時 - 2007-04-15 23:05:55

ANo.11

こんにちは。Wendy02です。

トラブルの発生も治まりました。今、試してみたら、全部アップロードできるようです。今回は、オリジナルには整形のインデントはついていますが、全角空白はナシにします。私個人のルールとしては、フリーというには、範囲は超えていますが、今回、私自身が共用できるものであることを条件にしました。しかし、配布をお考えの場合は、アドイン型のほうがよいです。アドイン型は、ThisWorkbookに、少し、手を加えなくてはならないことがあります。(そのときは、また、ここでもよいし、別途お尋ねになってもよいのですが、詳しい人は、あまりいません。また、今後は、COMアドインに移行していく関係で詳しい資料がだんだん少なくなっているようです。)

もし、仕様の段階で、それは話が違うという場合は、アップロードの前にお知らせください。仕様変更します。トラブルがない限りは、近くアップロードします。(確信犯的にアップロードしますので、少なくともWeekDayは避けたいです。)

それをする前に仕様書を書いておきます。

メニュー形式で、基本的には、メニューのヘルプの右となりに出てきます。

メニューは、

・ファイルリスト(L)
[コンボボックス]

 ここをクリックすると、ファイルのリストが出てきます。
並びは降順です。昇順にするオプションはついていませんが、プログラム的には可能です。
もともと、AddItem は、昇順に入るようになっているので、逆さに加えられています。
開けられなかったファイルは、[*]がついて、おそらく次回には消えてしまうはずです。仕様書を書いている時点では、正しく確認は取れていません。

・リストの編集

 UserFormで行っていたものを、テンポラリブック[MyFileList.xls] に出力されて、オプションボタンで処理するようにします。終了は、次のメニューをクリックしてください。手動で終了する場合は、メニューのファイル-閉じるを使わないとできません。

 これは、スクロールロックが掛かっていて、右側が見れないようになっていますが、その右側に、本来のパス付きのフルのファイル名が入っています。単なる取り込みのために、ファイル名が出ているだけで、ファイル名を削除しても、オプションボタンをオフにして、修正しても同じです。見かけだけに過ぎません。

・リストの編集終了

 これは、クリックして、そのブックを閉じれば取り込まれます。なお、そのテンポラリブックは、削除されてしまいます。すべて失った際に、再利用することも考えましたが、手動での取り込みは非常に難しいのでやめました。

・リストの全消去

 リストは、時にごみのように溜まって処理できなくなることを恐れ、全部、クリアにしてしまうオプションを付けました。また、時々、そのようなリクエストも経験的にあります。

・メニューの消去

 このメニュー自体は、テンポラリ属性は、False になっています。つまり、恒久的にメニューに組み込まれるものとされています。(個々のExcel.xlb ファイルの中)
 
ただし、このマクロを取り付けたExcelのPERSONAL.XLSに限ります。ですから、他のExcelでは現れません。場合によって、不必要になったときに、このモードを取り消す方法は、最初は分かっても、時が経つと、作った当人でも、できなくなります。ただ、今回は、特別にTAGを付けてありますので、自分で加工したり調べたりするときに、ひじょうに便利です。
Set CBBox1 = CommandBars.FindControl(, , "CB1")
'CB1' というのが、TAG です。

親のメニューを削除すれば、その子のメニューも消えますが、マクロ画面にしないで削除できるようにしてあります。当然、メニューを復活しても、ファイルリストは消えています。

 なお、私個人は、「固定モード(更新しない)」が必要だと思っています。私の場合は、数種類のものを、常に使っているからです。また、本来は、Outlook を使うと良いのですが、なぜか、Outlook2003 には、そういうOffice ファイル検索モードが見当たりません。

初期設定としては、
Private Const LIMIT_NUM As Integer = 10
ここだけですが、リストの数を設定していただくことになります。これは、表示が10までです。

それから、余談になりますが、マクロのVBAは、今後、どうなっていくのか、はっきりしたことは言えませんが、私個人としては、もうBasic 系はやめて新しい言語の勉強を始めてしまっています。今のところは、MS系からは離れられませんが、MSに振り回されるのに辟易としてしまいました。過去の資料が少ないし、現在の仕様が、その過去のものによるものが大きいのに、資料が手に入らない可能性が強いのです。VBAもそのひとつです。主に、アスキーから、日経になったことが大きな原因です。私は、オークション等でこまめに集めました。しかし、やっていることは前向きではありません。

今回、コードの個々の部分はあまり難しいものではありませんが、コードが集まると、共有変数の問題とか、いろいろ発生して、しばらくやっていないと、まごついてしまうことがありました。それでは、週末までお待ちください。

投稿日時 - 2007-04-12 13:35:10

お礼

お世話になります。大変お手数をおかけします。

仕様を拝見しましたが、全く異存はございません。細かい点、後々のことまで配慮していただき、ありがとうございます。また、リストの表示順について書き忘れていたにも関わらず、最新のものが上に来るようにしていただき、大変ありがたいです。

>フリーというには、範囲は超えていますが
おっしゃるとおりで、本来でしたら相応の代価が必要な仕事をしていただいたと承知しております。その点についてはわたしも心苦しく思っております。申し訳ありません。

>なお、私個人は、「固定モード(更新しない)」が必要だと思っています。
今思えば、こちらで質問させていただいたきっかけは、まさにそのような運用を行いたいというものでした。
一定期間同一の業務が続くということがよくあり、その場合、常にリストに残っていてほしいファイルがいくつかでてきます。そういうファイルを残してあとのファイルをリストから複数選択し、For~Nextループで一括消去したい、でもうまく動かないというのが、質問の発端でした。「固定モード」という考え方は、全く発想の外でしたので、質問にはそのようなことは書いておりませんが…
ただ、この点については、「リストの編集」メニューを用意してくださいましたので、充分運用できるのでは、と思っています。

完成したマクロをアップロードしていただけるのを心待ちにしております。よろしくお願いいたします。

投稿日時 - 2007-04-12 22:16:09

ANo.10

Wendy02です。

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

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

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

投稿日時 - 2007-04-11 13:43:40

お礼

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

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

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

投稿日時 - 2007-04-11 21:54:31

ANo.9

こんばんは。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字)

投稿日時 - 2007-04-10 01:28:48

補足

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

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

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

投稿日時 - 2007-04-10 09:06:01

ANo.8

こんばんは。

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

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

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

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

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

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

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

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

投稿日時 - 2007-04-08 02:35:28

補足

Wendy02さま

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

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

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

投稿日時 - 2007-04-08 09:09:56

ANo.7

こんにちは。

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

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

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

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

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

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

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

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

投稿日時 - 2007-04-07 16:19:37

補足

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

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

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

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

投稿日時 - 2007-04-07 18:48:03

ANo.6

#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年後かもしれません。人間は、知らないことは、どうしても知りたいという本能もありますが、それをじっとこらえることも大事かなって思います。(^^;

投稿日時 - 2007-04-07 13:53:18

補足

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

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

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

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

投稿日時 - 2007-04-07 14:55:04

ANo.5

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

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

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

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

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

投稿日時 - 2007-04-07 01:57:13

お礼

Wendy02さん

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

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

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

投稿日時 - 2007-04-07 08:24:37

ANo.4

こんばんは。

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

データだけを書き入れるなら、少なくとも、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: 

投稿日時 - 2007-04-07 00:54:12

補足

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

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

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

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

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

よくわかりました。

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

投稿日時 - 2007-04-07 01:27:34

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

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

投稿日時 - 2007-04-06 22:56:31

補足

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

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

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

投稿日時 - 2007-04-07 00:03:26

こんばんは。

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

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

投稿日時 - 2007-04-06 22:51:03

お礼

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

ご指摘のとおり、

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で教えていただいたように直したところ、見事に望みどおりの動きをしてくれるようになりました。ここ数日悩んでいたことが嘘のように解決しました。本当にありがとうございました。

投稿日時 - 2007-04-06 23:45:49

ANo.1

For i = 0 To .ListCount - 1

ListCountは1オリジン(1から始まる。0は項目がない状態)だったと思うのですが…

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

投稿日時 - 2007-04-06 22:17:52

補足

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

For i = 1 To .ListCount

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

投稿日時 - 2007-04-06 22:34:59

あなたにオススメの質問