0

特定のフォルダーからすべてのドキュメントを取得して取得し、そのフォルダー内のすべてのファイルを一覧表示するスクリプトがあります。次に、Excel 内からこれらのファイルを開くためのリンクを作成します。ファイルがメモ帳でのみ開くようにシェルに入れる方法があるかどうか疑問に思っていました。私が現在使用しているコードは次のとおりです。

Sub MakeLink(ByVal cell As Range, ByVal url As String, ByVal txt As String, ByVal tooltip_text As String)
        ActiveSheet.Hyperlinks.Add _
            Anchor:=cell, _
            Address:=url, _
            ScreenTip:=tooltip_text, _
            TextToDisplay:=txt
    End Sub

Sub Portfolios()

    Range("A1:Z200").Clear
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Range("A3").Font.Bold = True


    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets("Library")


     'Get the folder object associated with the directory
    Set objFolder = objFSO.GetFolder("C:\Portfolios")
    ws.Cells(3, 1).Value = "The files found in " & objFolder.Name & " are:"

     'Loop through the Files collection
    For Each objFile In objFolder.Files
        'ws.Cells(ws.UsedRange.Rows.Count + 3, 2).Value = objFile.Name
        MakeLink ws.Cells(ws.UsedRange.Rows.Count + 3, 2), objFile, objFile.Name, objFile.Name

    Next

     'Clean up!
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
End Sub

私はその線に沿って何かをしなければならないことを知っていますがMakeLink = Shell("C:\WINDOWS\notepad.exe", 1)、これがどこに収まるかについて少し問題を抱えているようです.

ありがとう

4

1 に答える 1

1

ファイルは、そのファイル タイプの既定のプログラムで開かれます。

強制的にメモ帳で開くようにしたい場合は、Worksheet_FollowHyperlinkイベントを処理するコードを記述する必要があります。Target パラメーターからセル テキストを取得し、そこからメモ帳をシェル化できます。

ハイパーリンクによってユーザーが別の場所に移動する問題を防ぐには、ハイパーリンクを含むセルと同じセルにターゲット アドレスを設定します。

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

    Dim fPath As String, res

    fPath = Target.TextToDisplay
    res = Shell("notepad.exe """ & fPath & """", vbNormalFocus)

End Sub

ハイパーリンクを作成するには:

Sub MakeLink(rng As Range, txt As String)
    Dim addr As String

    addr = "'" & rng.Parent.Name & "'!" & rng.Address(False, False)
    rng.Parent.Hyperlinks.add Anchor:=rng, Address:="", _
                     SubAddress:=addr, TextToDisplay:=txt

End Sub
于 2012-07-17T16:21:02.757 に答える