Excel单元格自动打开/closures文件窗口，并将文件名和path作为单元格值

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

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

1. 它应该自动打开/closures文件窗口。

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

3. 如果用户select多个文件，它应该将所有path/文件名选取到单元格中，使用| 作为分隔符。 像c:\folder1\file1.ext|d:\folder2\file2.ext

4. 如果用户点击一个单元格或第二次进入单元格，它应该保留现有的path/文件名，并让其他像3号一样添加其他path/ filnames

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函数（它没有被破坏，只是做了更多）

它将允许你双击任何单元格，这将打开一个文件对话框。

您可以select1个（或更多）文件

文件名将被join“|” 字符放在目标单元格中

如果任何预先存在的文件在单元格中，新的文件将被追加到它们中

但是，它不支持按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更改$A$1您想要的值，或者find一种方法来确定目标区域的名称（不是太困难）

如果你的工作表没有被locking，单击的单元格将保持焦点，并处于编辑模式，这有点烦人。 locking单元格，在以前的版本的Excel中解决这个问题（我认为它在v.2010 +不起作用）

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

 ....... 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 

以下function是打开文件对话框并检索文件名的function。

 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