投稿者: mabo52

ファイル名を取得するのに、文字列関数を操作して取り出しましたが、一発で取り出せる関数もあるようで
す。
FSO と呼ばれるものを使う方法で、詳細は、諸兄のHPに譲りたいと思いますが,

（fPath は目的のファイルまでのファイル名を含んだフルパス）
　　Dim FSO, PathName As String, FileName As String
　　Set FSO = CreateObject(“Scripting.FileSystemObject”)

　　FileName = FSO.GetFileName(fPath)・・・・・・ファイル名だけを取り出す。
　　PathName = FSO.GetParentFolderName(fPath)・・・・・・パスだけ取り出す。

ただ自分自身（マクロを記載したBOOK）の場合は次のようにして求めるようです。

　　ThisWorkbook.Name・・・・自分自身のファイル名
　　ThisWorkBook.FullName・・・自分自身のフルパス

ちなみに、

　　　FileName = FSO.GetFileName(ThisWorkbook)・・・・エラー

のようにファイル名を求めようとするとエラーになります。VBA　が良く分かっている方ならこんなことなさ
らないのでしょうがまだまだ勉強中の私にとって、ちょっと　？　になります。ただ、下記のようにするとき
ちんとファイル名を求められます。でも、ThisWorkbook.Name　でファイル名を求めることができるので、
意味ないですね。

　　　FileName = FSO.GetFileName(ThisWorkbook.FullName)・・・取得可

ただ、自分自身（マクロが書かれているファイル）のファイル名を求める場面は、それほど多くないかなと思います。

作ったプロシャージャを動かして、シートを選択している様子です。リストボックスのシート名をクリックすると、クリックしたシートに移動します。

どのシートが選ばれたかは、リストボックスの IndexID でわかります。Worksheets( IndexID).Name　で、選択されたシート名を表示できます。それほど使う場面はないかとは思いますが、使う時は、便利な機能のよ
うな気がします。

以下は、VBA　標準モジュールに記載したプロシャージャです。
Sub ボタン2_Click()　は、シートに貼り付けてある、マクロ起動用のものです。
Function sheets_set(Wb As Workbook) の中身は、本来ユーザーフォームの _Initialize()の項目に記入すべきでしょうが、Wb の引き渡し方法がわからないので、こちらに書きました。

－－－－－－－－－－－－－－－
Sub ボタン2_Click()
　　Call Select_sheet
End Sub
－－－－－－－－－－－－－－－
Function Select_sheet()
　　‘====読み込みフルパスファイル名の取得====
　　Dim fPath As Variant
　　Dim fType, prompt As String

　　fTyp = “Excelファイル(*.xlsm),*.xlsm,Excelファイル(*.xlsx),*.xlsx,Excelファイル(*.xls),*.xls”
　　prompt = “Excelファイルを選択してください”
　　fPath = Application.GetOpenFilename(fTyp, , prompt)

　　If fPath = False Then
　　　　MsgBox “ファイルが選択されていません。”
　　　　Exit Function
　　End If

　　‘====読み込みのファイル名取り出し====
　　Dim STR As String
　　Dim t_file_name As String

　　STR = StrReverse(fPath)
　　t_file_name = Right(fPath, InStr(STR, “\”) – 1)

　　‘====ファイルを開く処理====
　　Dim Wb As Workbook

　　If ThisWorkbook.FullName <> fPath Then
　　　　If fPath <> “” Then

　　　　For i = 1 To Workbooks.Count
　　　　　　If Workbooks(i).Name = t_file_name Then
　　　　　　　　BookFlag = True
　　　　　　End If
　　　　Next i

　　　　If BookFlag <> True Then
　　　　　　MsgBox “ファイルを開きます。”
　　　　　　Set Wb = Workbooks.Open(fPath, UpdateLinks:=Ture, ReadOnly:=Ture)

　　　　　　Call sheets_set(Wb)
　　　　　　UserForm1.Show vbModeless
　　　　Else
　　　　　　MsgBox “すでに開いているファイルを開こうとしてます。”
　　　　　　Exit Function
　　　　End If
　　　　End If
　　Else
　　　　MsgBox “自分自身を開こうとしてます。”
　　　　Exit Function
　　End If
End Function
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Function sheets_set(Wb As Workbook)
　　Dim i As Integer

　　With UserForm1.ListBox1
　　　　‘一つだけ選択
　　　　.MultiSelect = fmMultiSelectSingle
　　End With

　　For i = 1 To Wb.Worksheets.Count
　　　　UserForm1.ListBox1.AddItem (Wb.Worksheets(i).Name)
　　Next

　　UserForm1.ListBox1.ListIndex = 0
End Function

以下は、ユーザーフォームの方に記載したものです。

－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub CommandButton1_Click()
　　ThisWorkbook.Activate
　　Unload UserForm1
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub ListBox1_Click()
　　sh_name = ListBox1.List(ListBox1.ListIndex)
　　TextBox1.Text = sh_name
　　Worksheets(sh_name).Activate
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　　If KeyCode = vbKeyReturn Then
　　　　KeyCode = 0
　　　　ThisWorkbook.Activate
　　　　Unload Me
　　End If
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Private Sub UserForm_Initialize()
　　With ListBox1
　　‘一つだけ選択
　　.MultiSelect = fmMultiSelectSingle
　　End With
End Sub

エラー処理２・・・・自分自身を開こうとする。

　　このエラー処理は、自分自身を開くとまずいので、ThisWorkbook.FullName　と　開こうとするファイ
　　ルのフルパスの　fPath　を比較することで、同じなら、「自分自身を開こうとしてます。」のメッセージ
　　を出して、Function 　を抜け出します。

　　If ThisWorkbook.FullName <> fPath Then
　　　　・
　　　　・＊開こうとするファイルとすでに開いているファイルを比較する。
　　　　・
　　Else
　　　　MsgBox “自分自身を開こうとしてます。”
　　　　Exit Function
　　End If

　　次の処理のファイルを比較するに先立ち、開こうとするファイルのファイル名を取り出しておきます。い
　　くつか方法をためしましたが、文字列を編集する方法がいいみたいで、フルパスを文字の後尾から　”￥”　
　　を探してファイル名を取り出します。緑の”￥”を探しだせば、赤のフィル名を取り出せます。

　　　　E:￥VBA開発￥シート選択￥Dummy.xlsx
　　　　　　　　　　　　　　　　　　←←←←←

　　はじめ、InStrRev を使ってみましたが、思った結果がでなかったので（後でわかりました）文字列を反転
　　して、先頭から”￥”の探し出し、その文字のある手前まで切り出して、ファイル名を取得しました。なん
　　と、InStrRev　関数は、後ろから文字を探すのですが、見つけた場所の位置を、後ろから数えた位置では
　　なく、前から数えた位置を返すみたいでした。下記のようにして　 t_file_name　にファイル名を取り込
　　みました。
　　‘====読み込みのファイル名取り出し====
　　 Dim STR As String
　　 Dim t_file_name As String

　　 STR = StrReverse(fPath)
　　 t_file_name = Right(fPath, InStr(STR, “\”) – 1)

エラー処理３・・・・既に開いているファイルを開こうとする。
　　既に開いている　Book数を　Workbooks.Count　で取得して、For　ループの中で、開こうとしている
　　ファイル名と比較し、同名のファイルがあれば、True　を　そうでなければ　False　をセットして判定し
　　ます。開いているファイル名は、Workbooks(i).Name　で取得できます。
　　False の場合だけ（同じファイルがない）,目的のファイルを開き、Call sheets_set(Wb)　で、取得する
　　シート名をユーザーフォームのリストボックスに、セットします。

　　For i = 1 To Workbooks.Count
　　　　If Workbooks(i).Name = t_file_name Then
　　　　　　BookFlag = True
　　　　End If
　　Next i

　　If BookFlag <> True Then
　　　　MsgBox “ファイルを開きます。”
　　　　Set Wb = Workbooks.Open(fPath, UpdateLinks:=Ture, ReadOnly:=Ture)

　　　　Call sheets_set(Wb)
　　　　UserForm1.Show vbModeless
　　Else
　　　　MsgBox “すでに開いているファイルを開こうとしてます。”
　　　　Exit Function
　　End If

お手伝いでしている仕事がらみの作業用に、何年かかけて、VBAのプロシャージャを作成しました。おかげ様で、短い時間でその処理ができるようになりました。

ただ、時々でるエラーを、その都度修正したりしながら、使ってきました。自分で作成したプロシャージャなので、なぜエラーが起こったのか、ちょっと流れを見ればわかるのですが、なるべく直さなくてもいいように、作り直したいなと思ってました。

やっていることは至極簡単なことですが、手作業でやると結構な時間とられるので、どうしても、プロシャージャが必要でした。継ぎ足し継ぎ足ししてきたので、結構な分量のプロシャージャになってしまってますので、全部作り直すことは、なかなかできないのですが、ある作業の一部分だけでも、考えられるエラーについての対処を十分にできるようにしたいなと、手直しをし始めました。

今回、作業の対象にしたので、他のエクセルブックを選択して開き、そのブックのシートを選択する、という部分のプロシャージャです。今日、一日、かかって、ほぼ、できたので、備忘録がてら、記載します。

エラー処理１・・・・存在しないファイルを開こうとする。
　　このエラーの回避は、GetOpenFilename　を使って、それそれのディレクトリーを開いて、これから開こ
　　うとするファイルを選択して開くということで、回避しました。ただこの画面で、キャンセルを押してし
　　まうと、「ファイルが選択されてません。」のエラーとなりプロシャージャが中断してしまい、fPath　に
　　　False　がセットされますので、IF 文でFunction　を抜け出すことで、回避しました。

　　‘====読み込みフルパスファイル名の取得====
　　 Dim fPath As Variant
　　 Dim fType, prompt As String

　　 fTyp = “Excelファイル(*.xlsm),*.xlsm,Excelファイル(*.xlsx),*.xlsx,Excelファイル(*.xls),*.xls”
　　 prompt = “Excelファイルを選択してください”
　　 fPath = Application.GetOpenFilename(fTyp, , prompt)

　　 If fPath = False Then
　　 　　MsgBox “ファイルが選択されていません。”
　　 　　Exit Function
　　 End If