[[20191130103048]]　『ファイルを開くＶＢＡ』（むじゅかしい）　ページの最後に飛ぶ

『ファイルを開くＶＢＡ』（むじゅかしい）

はじめまして。よろしくおねがいします。
今、社内で社員だれもがさわる可能性のあるデータベースを作成しています。
その中で、この商品をすぐ見れるようにしてくれと言われています。

シート上のセル名を使って違う階層にあるエクセルファイルを開きたいのですが、いい案ありましたら宜しくお願いします。
できるだけ簡単な操作で開きたいのです。
例えば、

　　　　Ａ　　　　B　　　　
1　　　123　　　○○

2　　　456

3　　　789

4　　　012

とありB列以降データがＯ列まで入っています。
ハイパーリンクの設定を考えましたが、1000行くらいあるデータなのでなかなか厳しいです。A列のセルだけクリックするとファイルを開くことができるようなVBAは可能でしょうか？もしくは、Ａ１セルを右クリックすると「ファイルを開く」みたいな選択肢ができてそれをクリックしたらある階層の「123.xlsm」を開くことができればうれしいです。他に案があれば教えていただきたいと思いますのでどうかよろしくお願いします。
できれば操作が簡単で他の社員が間違わずに操作できるのがいいです。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

＞ハイパーリンクの設定を考えましたが、1000行くらいあるデータなのでなかなか厳しいです。
よくわかりませんが、HYPERLINK関数を使えば、1000件くらい瞬殺なのでは？

  ___A_____B_____
 1  123   =HYPERLINK("C:\ある階層\"&A1&".xlsm","○○")
 2  456                   ↓フィルコピー
 3  789
 4  012

（もこな２） 2019/11/30(土) 12:22

やりたいことが決まりました。
右クリックメニューにコマンドを登録してマクロと関連付ける方法と、さらにそのサブメニューにもマクロを登録する方法を教えてください。
先ほどの右クリックでメニューがでてきてサブメニューで「エクセルファイル」と「ＰＤＦファイル」をセル名から検索して開ける方法を教えてください。
ハイパーリンクではこれから先もっとデータが増えるため重くなってしまうのを懸念しています。だからＶＢＡで対処したいのでよろしくお願いいたします。
（むじゅかしい） 2019/11/30(土) 13:10

追記

ネット引用ですがこんな感じです。

Sub コマンド追加()

  With CommandBars("cell").Controls.Add(Before:=1, Type:=msoControlPopup)
      .Caption = "マクロ実行"
  With .Controls.Add
       .Caption = "マクロ1"
       .OnAction = "マクロ1"
End With
  With .Controls.Add
       .Caption = "マクロ2"
       .OnAction = "マクロ2"
End With
End With
End Sub

Sub マクロ1()

   MsgBox "マクロ1"
End Sub

Sub マクロ2()

   MsgBox "マクロ2"
End Sub

これをファイル起動時にはこのシートにのみ適用されるようにするのと、マクロ１をセル名からエクセルファイル検索、マクロ２をセル名からＰＤＦファイル検索にしたいのでよろしくお願いします
（むじゅかしい） 2019/11/30(土) 13:22

書いている間にかぶりましたが、とりあえず。

■１
＞右クリックメニューにコマンドを登録してマクロと関連付ける方法と
http://officetanaka.net/excel/vba/tips/tips30.htm

■２
＞さらにそのサブメニューにもマクロを登録する方法
何を聞きたいのか理解できないのでパス

■３
＞先ほどの右クリックでメニューがでてきてサブメニューで
たぶん、ユーザーフォームを使うとかになりそう。
それとも、右クリックメニューに階層を付けたいという話なんでしょうか？
そうであれば、やったことないけど調べてみたら↓がヒットしました。
https://excel-ubara.com/excelvba5/EXCELVBA223.html

■４
＞「エクセルファイル」と「ＰＤＦファイル」をセル名から検索して

 × セル名
 ○ セルの値 と解釈して

http://officetanaka.net/excel/vba/function/Dir.htm

■５
＞「エクセルファイル」と「ＰＤＦファイル」を～開く
https://www.moug.net/tech/exvba/0100034.html
http://officetanaka.net/excel/vba/function/Shell.htm

■６
＞ハイパーリンクではこれから先もっとデータが増えるため重くなってしまう
そうなんですかね？
ただのリンクである以上実体はないでしょうし、再計算されたとしても隣のセルを参照してるくらいなので、問題視するレベルになるとも思えませんが、実際に試してないので私には分かりません。

■７
＞ＶＢＡで対処したいのでよろしくお願いいたします。
そうですか。がんばってください。

"質問"なら分かる範囲でお答えしますが、作業（開発）依頼であれば、別の方をお待ち下さい。

（もこな２） 2019/11/30(土) 13:40

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    Dim cmdBra1 As CommandBarControl
    Dim cmdBra2 As CommandBarControl
    '標準状態にリセット
    Application.CommandBars("Cell").Reset
    '全てのメニューを一旦削除
    For Each cmdBra1 In Application.CommandBars("Cell").Controls
        cmdBra1.Visible = False
    Next
    '以下で、新規のメニューを追加
    Set cmdBra1 = Application.CommandBars("Cell").Controls.Add(Before:=1)
        With cmdBra1
            .Caption = "未定"
            .FaceId = 481
            .OnAction = "未定"
        End With
    Set cmdBra1 = Application.CommandBars("Cell").Controls.Add(Before:=2, Type:=msoControlPopup)
        With cmdBra1
           .Caption = "図面出力"
        End With
    Set cmdBra2 = cmdBra1.Controls.Add()
        With cmdBra2
           .Caption = "エクセル"
           .FaceId = 263
           .OnAction = "エクセルファイルオープン"
        End With
    Set cmdBra2 = cmdBra1.Controls.Add()
        With cmdBra2
            .Caption = "ＰＤＦ"
           .FaceId = 95
           .OnAction = "ＰＤＦファイルオープン"
        End With
    Application.CommandBars("Cell").ShowPopup
    Application.CommandBars("Cell").Reset
    Cancel = True
End Sub

Sub 未定()

    ActiveCell.Value = "未定"

End Sub

Sub エクセルファイルオープン()

    ActiveCell.Value = "エクセル"

End Sub

Sub PDFファイルオープン()

    ActiveCell.Value = "ＰＤＦ"

End Sub

ここまでは自力で何とかでき、サブメニューまで表示できました。
次はアクティブセルに拡張子をつけてファイル検索なんですが
Dim s As String
s = ActiveCell.Address
というのが検索するとでてきました。
これをどうしたらいいのですか？
（むじゅかしい） 2019/11/30(土) 14:49

 セルに ファイルのフルパスが入っているとして

 Option Explicit

 Sub test()
    If Len(Dir(ActiveCell.Value)) = 0 Then
        MsgBox "指定したファイルは存在しません"
        Exit Sub
    End If
    ThisWorkbook.FollowHyperlink ActiveCell.Value
 End Sub

 で、たいていのファイルはその関連付けられたアプリで開くと思います。
 （ExcelファイルでもPDFでも）
 ただ、セルに 拡張子無しのファイル名のみであれば パスと拡張子を付けてあげる必要があります。
 ExcelファイルとPDFファイルが混在しているのであればそれを判断する仕組みが必要ですね

 セルにExcelファイル名が入力されているとき 「PDFファイルオープン」をクリックしたらどうなるかです。

（渡辺ひかる） 2019/11/30(土) 15:51

渡辺様　

ありがとうございます。だいたいのことろまで進んでいるのですが。。。

＞セルに拡張子無しのファイル名のみであればパスと拡張子を付けてあげる必要があります。

この部分だけでも教えていただきたいのですが可能でしょうか？

（むじゅかしい） 2019/11/30(土) 16:12

 C:\aaa\bbb\ccc\ddd.xlsx

 というのが フルパスであり セルに ddd と入力されているとすれば

 "C:\aaa\bbb\ccc\" & ActiveCell.value & ".xlsx"

 で取得できると思います。

（渡辺ひかる） 2019/11/30(土) 16:21

渡辺様　

返信遅くなり申し訳ございません。

ありがとうございます。早速やってみたいと思います。

またわからないことがあれば質問さあせていただくので、

またよろしくお願いします。
（むじゅかしい） 2019/12/02(月) 08:26

エクセルファイルは開いたのですがＰＤＦファイルが開かないです。

  Dim Filepath
  Filepath = "C:\aaa\bbb\ccc\" & ActiveCell.value & ".xlsx"

  If Dir(Filepath) = "" Then
    MsgBox "指定したファイルは存在していません"
    Exit Sub
  End If

  Dim FSO As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")

  Dim Filename
  Filename = FSO.GetFileName(Filepath)

  'filenameと同名のエクセルブックを取得
  Dim workbookWithSameName As Workbook
  Set workbookWithSameName = getWorkbookByName(Filename)

  '同名のエクセルブックがあるときはNothing「ではない」
  If Not workbookWithSameName Is Nothing Then
    If workbookWithSameName.FullName <> Filepath Then
      MsgBox "同名のエクセルブックを開いているためファイルを開けません"
      Exit Sub
    End If
  End If

  Dim targetWorkbook As Workbook

  If workbookWithSameName Is Nothing Then
    Set targetWorkbook = Workbooks.Open(Filepath)
  Else
    Set targetWorkbook = workbookWithSameName
  End If

End Sub

これはエクセルファイルを開くコードというのは分かるのですが、ＰＤＦを開くのにはどこを
変えたらいいのですか？
「Shell」を使用するのは分かりますがどの部分をかえたらいいのですか？

よろしくお願いします。

（むじゅかしい） 2019/12/02(月) 10:34

 ＞「Shell」を使用するのは分かりますがどの部分をかえたらいいのですか？

 当然そういう質問が来ると思って

 （渡辺ひかる） 2019/11/30(土) 15:51

 のアドバイスとしたのですが、読んでもらったのでしょうか？

（渡辺ひかる） 2019/12/02(月) 11:02

あ、一回試したんですがうまいこといかずにスルーしてしまっていました。。すいません。

Option Explicit

Sub test()

 Dim Filepath
  Filepath = "C:\aaa\bbb\ccc\" & ActiveCell.Value & ".xlsm"

   If Len(Dir(Filepath)) = 0 Then
        MsgBox "指定したファイルは存在しません"
        Exit Sub
    End If
    ThisWorkbook.FollowHyperlink ActiveCell.Value

 End Sub

これでやってみたんですが「指定されたファイルを開きくことができません」とでます。

ネットで調べて色々やってはいるのですが、無知なのでなかなか難しくてうまいこと進みません（泣）

どうすればいいですか？

（むじゅかしい） 2019/12/02(月) 11:53

 ＞これでやってみたんですが「指定されたファイルを開きくことができません」とでます。

 よく読んでくださいね

 ＞ セルに ファイルのフルパスが入っているとして

 という前提があります。

 実際には　ActiveCell.Value　にはフルパスが入っていないので

 Filspath　にフルパスを入れているのでしょう？

 でしたら

   ThisWorkbook.FollowHyperlink Filspath

 で開くはずです。

 ただし、ExcelとPDFで拡張子を変えなければならないことに注意してください

（渡辺ひかる） 2019/12/02(月) 12:02

できましたぁぁぁ。

無知な私に丁寧に何回も教えていただいてありがとうございました。
（むじゅかしい） 2019/12/02(月) 13:04

コメント返信：

[ 一覧(最新更新順) ]

[[20191130103048]] 『ファイルを開くＶＢＡ』（むじゅかしい） ページの最後に飛ぶ

[[20191130103048]]　『ファイルを開くＶＢＡ』（むじゅかしい）　ページの最後に飛ぶ