Excel单元格自动打开/关闭文件窗口，并将文件名和路径作为单元格值

Question

我是Excel中的新手。我需要像下面这样的东西。

当用户点击一个单元格或输入到单元格时：

1. 应自动打开/关闭文件窗口。

2. 当用户选择一个文件时，它应该选择路径/文件名并放入单元格，如c:\folder1\file1.ext

3. 如果用户选择多个文件，则应将所有路径/文件名选取到单元格中，并将|作为分隔符。比如c:\folder1\file1.ext|d:\folder2\file2.ext

4. 如果用户单击一个单元格或第二次进入单元格，它应该保留现有的路径/文件名，并允许添加其他路径/过滤名称，如3号

Answer 1

这与Sid类似，只需双击任何单个单元格即可打开文件对话框。

在模块中

Public Function getList(Optional ByVal Target As Range = Nothing) As String
Dim Dialog As FileDialog
Dim File As Integer
Dim Index As Integer

Dim List() As String
Dim Item As Integer
Dim Skip As Boolean

Set Dialog = Application.FileDialog(msoFileDialogFilePicker)

File = Dialog.Show

If File = -1 Then
    ' Get a list of any pre-existing files and clear the cell
    If Not Target Is Nothing Then
        List = Split(Target.Value, "|")
        Target.Value = ""
    End If
    ' Loop through all selected files, checking them against any pre-existing ones to prevent duplicates
    For Index = 1 To Dialog.SelectedItems.Count
        Skip = False
        For Item = LBound(List) To UBound(List)
            If List(Item) = Dialog.SelectedItems(Index) Then
                Skip = True
                Exit For
            End If
        Next Item
        If Skip = False Then
            If Result = "" Then
                Result = Dialog.SelectedItems(Index)
            Else
                Result = Result & "|" & Dialog.SelectedItems(Index)
            End If
        End If
    Next Index
    ' Loop through the pre-existing files and add them to the result
    For Item = UBound(List) To LBound(List) Step -1
        If Not List(Item) = "" Then
            If Result = "" Then
                Result = List(Item)
            Else
                Result = List(Item) & "|" & Result
            End If
        End If
    Next Item
    Set Dialog = Nothing
    ' Set the target output if specified
    If Not Target Is Nothing Then
        Target.Value = Result
    End If
    ' Return the string result
    getList = Result

End If
End Function

在工作表代码中

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then getList Target
End Sub

<强>更新 我已经改变了getList函数（它没有被破坏，只是让它做得更多）

• 它将允许您双击任何单元格，这将打开文件对话框。
• 您可以选择1个（或更多）文件
• 文件名将与“|”结合字符并放入目标单元格
• 如果单元格中有任何预先存在的文件，则新的文件将附加到它们

但是，它不支持按Enter键打开文件对话框，必须双击该单元格。

<强>更新 帮助VMO（评论者）

工作表模块中的代码：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        If Target.Address = "$A$1" Then ' See Notes Below
            Target.Value = getList(Target)
        End If
    End If
End Sub

要限制哪些单元格可以双击，您需要使用类似的东西。您可以将$A$1更改为您想要的任何内容，或者找到确定目标范围名称的方法（不太难）

如果您的工作表未锁定，则单击的单元格将保持焦点，并处于编辑模式，这有点烦人。锁定单元格，在以前版本的excel中修复了这个（我认为它在v.2010 +中不起作用）

模块中的代码（getList）可以保持几乎完全相同（尽管您可能希望删除处理多个文件的所有代码，但不是必需的）。您需要做的就是添加一行代码。

.......
Dim Skip As Boolean

Set Dialog = Application.FileDialog(msoFileDialogFilePicker)

Dialog.AllowMultiSelect = False ' This will restrict the dialogue to a single result

File = Dialog.Show

If File = -1 Then
......

希望这会有所帮助，我明白你在问什么！

Answer 2

这应该可以解决问题。第一个子例程是用户单击单元格时触发的事件。更改第一个if语句中的行号和列号以更改目标单元格。您可以将所有这些代码放在代码模块中，以供您希望它使用的工作表。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim filenames() As String
    Dim filename As Variant
    Dim filelist As String

    ' Make sure the user clicked our target cell

    If Target.Row = 2 And Target.Column = 2 Then

        ' Get a list of filenames

        filenames = GetFileNames

        ' Make sure we got some filenames

        If UBound(filenames) > 0 Then

            ' Go through the filenames, adding each to the output string

            For Each filename In filenames
                filelist = filelist & CStr(filename) & "|"
            Next filename

            ' Remove the final delimiter

            filelist = Left(filelist, Len(filelist) - 2)

            ' Apply the output string to the target cell (adding another
            ' delimiter if there is already text in there)

            If Not Target.Value = "" Then
                Target.Value = Target.Value & "|"
            End If

            Target.Value = Target.Value & filelist

        End If

    End If

End Sub

以下函数用于打开文件对话框并检索文件名。

Private Function GetFileNames() As String()

    Dim dlg As FileDialog
    Dim filenames() As String
    Dim i As Integer

    ' Open a file dialogue

    Set dlg = Application.FileDialog(msoFileDialogFilePicker)

    With dlg
        .ButtonName = "Select"                  ' Text of select/open button
        .AllowMultiSelect = True                ' Allows more than one file to be selected
        .Filters.Add "All Files", "*.*", 1      ' File filter
        .Title = "Select file(s)"               ' Title of dialogue
        .InitialView = msoFileDialogViewDetails
        .Show

        ' Redimension the array with the required number of filenames

        ReDim filenames(.SelectedItems.Count)

        ' Add each retrieved filename to the array

        For i = 1 To .SelectedItems.Count
            filenames(i - 1) = .SelectedItems(i)
        Next i

    End With

    ' Clean up and return the array

    Set dlg = Nothing
    GetFileNames = filenames

End Function