I am newbie in Excel. I need to something like below.
When user click on a cell or enter to cell:
It should automatically open/close file window.
When user select a file, it should pick up path/filename and put into the cell, like c:\\folder1\\file1.ext
If user select more than one file, it should pick up all path/filenames into cell,with |
as delimiter. like c:\\folder1\\file1.ext|d:\\folder2\\file2.ext
If user click on a cell or enter to cell for a second time, it should keeps existing path/filenames and let to add other path/filnames to them like in number 3
This is similar to Sid's, just lets you double click any single cell to open the file dialog.
In a Module
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
In Your Worksheet's Code
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
Update I've changed the getList function (it wasn't broken, just made it do more)
It does not however support pressing enter to open the file dialog, you must double-click the cell.
Update To help VMO (commenter)
The code in the worksheet module:
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
To restrict what cell(s) are double-click'able you will need to use something like that. You can change $A$1
to whatever you want or find a way to determine the target range's name (not too difficult)
If your worksheet is not locked the cell that is clicked will keep focus, and be in edit-mode which is a little annoying. Locking the cell, in previous versions of excel fixed this (i think it doesn't work in v.2010+ though)
The code in the module (getList) can remain almost exactly the same (although you might want to remove all the code that deals with multiple files, not required though). All you need to do is add one line of code.
.......
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
......
Hope this helps and I've understood what you were asking!
This should do the trick. The first subroutine is the event that is triggered on the user clicking on a cell. Change the row and column numbers in the first if
statement to change the target cell. You can put all of this code in the code module for the worksheet you want it to work on.
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
The following function is that which is called to open the file dialogue and retrieve the filenames.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.