簡體   English   中英

Excel單元格自動打開/關閉文件窗口,並將文件名和路徑作為單元格值

[英]Excel cell auto open/close file window and put filename and path as cell value

我是Excel的新手。 我需要像下面這樣的東西。

當用戶單擊單元格或輸入單元格時:

  1. 它應該自動打開/關閉文件窗口。

  2. 當用戶選擇一個文件時,它應該選擇路徑/文件名並放入單元格,如c:\\folder1\\file1.ext

  3. 如果用戶選擇多個文件,它應該使用|來獲取所有路徑/文件名到單元格中 作為分隔符。 比如c:\\folder1\\file1.ext|d:\\folder2\\file2.ext

  4. 如果用戶單擊一個單元格或第二次進入單元格,它應該保留現有的路徑/文件名,並允許添加其他路徑/文件名,如3號

這類似於Sid,只需雙擊任何單個單元格即可打開文件對話框。

在一個模塊中

該圖顯示了粘貼getList代碼的位置

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更改$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
......

希望這有幫助,我明白你的要求!

這應該可以解決問題。 第一個子例程是用戶單擊單元格時觸發的事件。 更改第一個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

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM