エクセルVBA セルに表示されたテキストと同じ名前のファイルを開きたい

質問

EXCEL2003を使っています。コマンドボタンをクリックすると、VLOOKUPなどで検索し、あるセルに表示させた文字と同じ名前のファイルを開くVBAを教えてください。ファイルは同フォルダにあります。VBA初心者です。よろしくお願いします。

回答No.7

Wendy02 · ベストアンサー

こんにちは。Wendy02 です。

＞今はツール→マクロ→マクロという手順で行うしか
＞私の知識不足でできません。

ツールバーを右クリックして、[コントロールツール]を出し、その中から、コマンドボタンを選んで、シートに貼り付けます。

そのボタンを右クリックすると、

コードの表示というのがあります。それをクリックします。

そうすると、Visual Basic Editor画面が現れその中には、以下のように出ているかと思います。

Private Sub CommandButton1_Click()

End Sub

そこで、その間に以下のように書き加えます。
（ただし、マクロ名は、FindFileName　が、「標準モジュール」に登録されていることが条件です。）

　　↓
Private Sub CommandButton1_Click()
　Call FindFileName　　'一行書き加えます。
End Sub

なお、ツール－マクロ－マクロという代わりに、Altを押しながら、F8 を押すとマクロ名の一覧が出ます。

お礼

できました！本当にありがとうございました。

回答No.6

taocat

再度のこんにちは。No.3です。
既にWendy02さんがフォローしてくださってますが、

開きたいファイル名が、例えば、"売上.xls"　
それが、セルＡ１に入力されているとした場合

先のコードでは、セルＡ１には、"売上.xls"と拡張子（.xls)込みで入力されているものとしています。
もし、拡張子なしで、"売上"　とだけ入力されているのであれば、
下記のように●のところに拡張子（.xls）を付加しましょう。

---------------------------------------------
Private Sub CommandButton1_Click()

　Dim Wbk As Workbook
　Dim Fname As String

　Fname = Range("A1").Value & ".xls"　　'●ここ

　For Each Wbk In Workbooks
　　　If Wbk.Name = Fname Then
　　　　　MsgBox Fname & "は既にオープンされています"
　　　　　Exit Sub
　　　End If
　Next Wbk

　If Dir(Fname) = "" Then
　　　MsgBox Fname & "はありません"
　Else
　　　Workbooks.Open Fname
　End If

End Sub

-----------------------------------------
以上です。

お礼

ありがとうございました。開けました。やはり拡張子のせいだったようです。どうもすみませんでした。

回答No.5

Wendy02

こんにちは。

＞シート内にある顧客マスターを電話番号やふりがなの一部から検索し、あるセルに表示させ、そのセル内の名前と同じブックを開かせたいのです。

これは、具体的なセル情報がないと、編集していただかなくてはなりません。また、ふりがな情報はセル上に出されているものとします。それは、書かれていないので、こちらかで作ったものをサンプルとさせていただきます。

なお、#3 のtaocat さんに関するものは、

＞、「***はありません」となってしまいます。***は確かに同フォルダ内にあるのですが・・・。何か私のやり方が悪いんでしょうか?

これは、たぶん、セル上のリストにあるファイル名(Fname)に、.xls の拡張子がついていないからだと思います。

以下は、こちらで考えたサンプルです。

　　A　　　　B　　　　C　　　　D　　　　　　E
1　名前　　ふりがな　　住所　　電話番号　　ファイル名
2　朝日　　アサヒ　　　東京　　12-124　　　050821a
3　毎日　　マイニチ　　大阪　　12-125　　　050822a

'<標準モジュール登録>
Option Explicit
Sub FindFileName()
　Dim myFind As String, myFadd As String, rtn As Integer
　Dim DataRng As Range
　Dim c As Range
　Set DataRng = Range("A1").CurrentRegion　'リストのある左端上を設定
　myFind = Application.InputBox("検索値を入力してください。", Type:=2)
　If myFind = "False" Or myFind = "" Then Exit Sub
　Set c = DataRng.Find(What:=myFind, LookIn:=xlValues, LookAt:=xlPart)
　If Not c Is Nothing Then
　　myFadd = c.Address
　　Do
　　　rtn = MsgBox(DataRng.Cells(c.Row, 1) & "でよろしいですか？", _
　　　vbYesNoCancel)
　　　If rtn = vbYes Then
　　　　Call OpenFile(DataRng.Cells(c.Row, 5))
　　　　Exit Sub
　　　ElseIf rtn = vbCancel Then
　　　　Exit Sub
　　　End If
　　　Set c = DataRng.FindNext(c)
　　Loop Until c Is Nothing Or c.Address = myFadd
　End If
End Sub
Private Sub OpenFile(Fname As String)
Dim myFno As Integer
　If InStr(Fname, ".xls") = 0 Then
　　Fname = Fname & ".xls"
　End If
　　If Dir(Fname) <> "" Then
　　　myFno = FreeFile
　　　On Error Resume Next
　　　Open Fname For Binary Lock Read Write As #myFno
　　　Close #myFno
　　　If Err.Number = 0 Then
　　　　Workbooks.Open Fname
　　　ElseIf Err.Number = 70 Then
　　　　MsgBox Fname & "は開いています。", 64
　　　　Err.Clear
　　　End If
　　Else
　　　MsgBox Fname & "は存在しません。", 16
　　End If
End Sub

お礼

ほぼ私のやりたかったことができました。感激です。本当にありがとうございました。ついでにもう一つお聞きしたいのですが、このマクロをコマンドボタンから呼び出すのはできますか？今はツール→マクロ→マクロという手順で行うしか私の知識不足でできません。よろしくお願いします。

回答No.4

komet163

こんにちは。
>文字と同じ名前のファイル
がエクセルブックとは限らないかもしれないので、

Private Sub CommandButton1_Click()
Dim sPath As String
sPath = ThisWorkbook.Path & "\" & Range("A1").Value
If Dir(sPath) <> "" Then
　With CreateObject("WScript.Shell")
　　.Run """" & sPath & """"
　End With
End If
End Sub

としてみました。
（A1セルには、開きたいファイルの「ファイル名.拡張子」があるとします。）

関連付けされたファイルなら全て開きます。
ブックの場合、既に開いていたときはアクティブになります。

お礼

ありがとうございます。お礼が遅くなってごめんなさい。今回はエクセルブックのみですが、そうではない時の参考になりました。みなさん凄いですね。

回答No.3

taocat

こんばんは。
該当ブックが既にオープンされてる場合のチェックも入れたほうがベターですね。

-------------------------------------------------

Private Sub CommandButton1_Click()

　Dim Wbk As Workbook
　Dim Fname As String

　Fname = Range("A1").Value

　For Each Wbk In Workbooks
　　　If Wbk.Name = Fname Then
　　　　　MsgBox Fname & "は既にオープンされています"
　　　　　Exit Sub
　　　End If
　Next Wbk

　If Dir(Fname) = "" Then
　　　MsgBox Fname & "はありません"
　Else
　　　Workbooks.Open Fname
　End If

End Sub

-------------------------------------------
以上です。

お礼

ありがとうございます。お礼が遅くなってごめんなさい。教えていただいたようにしたのですが、「***はありません」となってしまいます。***は確かに同フォルダ内にあるのですが・・・。何か私のやり方が悪いんでしょうか?

回答No.2

Wendy02

こんばんは。

＞VLOOKUPなどで検索し、
この部分の意味がわかりませんが、こういうことでしょうか？
一応、カレントディレクトリのファイル名を検索して、その名前があれば、ブックを開くようにしています。

Private Sub CommandButton1_Click()
　Dim Fname As String
　Fname = Range("A1").Value
　If Dir(Fname) <> "" Then
　　Workbooks.Open Fname
　End If
End Sub

補足

ありがとうございます、説明不足ですみません。私がしたいのはこんなことです。シート内にある顧客マスターを電話番号やふりがなの一部から検索し、あるセルに表示させ、そのセル内の名前と同じブックを開かせたいのです。他に良さそうなやりかたがございましたらご教授下さい。

回答No.1

Gody

Sheet1のA1のセルを対象にしたと仮定すると、以下のような記述で可能だと思いますが、どうでしょうか。

Sheets("Sheet1").Activate
Workbooks.Open Range("A1").Value

お礼

ありがとうございました。お礼が遅くなってごめんなさい。