2012-12-15 52 views
1

我是Excel中的新手。我需要下面的東西。Excel單元格自動打開/關閉文件窗口並將文件名和路徑作爲單元格值

當在一個小區用戶點擊或輸入到單元格:

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

  2. 當用戶選擇一個文件,它應該拿起路徑/文件名,並把進入細胞內,就像c:\folder1\file1.ext

  3. 如果用戶選擇一個以上的文件,它應該拿起所有的路徑/文件名進入細胞,以|作爲分隔符。像c:\folder1\file1.ext|d:\folder2\file2.ext

  4. 如果一個小區用戶點擊或進入細胞第二次,它應該一直存在的路徑/文件名,並讓在數量上增加其他的路徑/ filnames他們像3

回答

3

這與Sid的類似,只是讓你雙擊任何一個單元打開文件對話框。

在模塊

image showing where to paste the getList code

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 

在工作表中的代碼

image showing where to paste the sheet 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 

更新 我已經改變了的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 

要限制單元格是雙click'able,你將需要使用類似的東西。你可以改變$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 
...... 

希望這會有所幫助,我明白你在問什麼!

+0

我複製了你的代碼在vba代碼中爲sheet1 ...但它沒有工作..沒有行1和列1 ...我把'MsgBox'作爲測試,但似乎,它不運行代碼! – Amir

+0

您是否還添加了新的代碼模塊並將其他代碼塊放入? – NickSlash

+0

我添加了'module1'並且放置了'Public Function getList ...',然後在vba頁面上雙擊'sheet1',然後將'Private Sub Worksheet_BeforeDoubleClick ...'放入其中。 – Amir

1

這應該做的伎倆。第一個子例程是用戶單擊單元格時觸發的事件。更改第一個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 
+0

我將你的代碼複製到了sheet1的vba代碼中......但它沒有工作..沒有爲第2行和第2列採取行動......我爲測試放了一個'MsgBox',但似乎它不運行代碼! – Amir

+0

@Amir您是否將第一個例程放入Sheet1的代碼模塊中?如果是這樣,那可能是因爲你有某個地方正在關閉宏。您確定在您的Excel安裝中啓用了宏嗎? –

+0

我很抱歉,但我不明白,雖然沒有宏運行,爲什麼我需要啓用宏。順便說一句,我啓用'開發者'選項卡,然後在'宏安全'頁面,我啓用'啓用所有宏'選項... 現在,當我點擊定義的單元格,它運行您的VBA代碼,但有'filenames = GetFileNames'上出錯,看起來'GetFileNames'函數返回空字符串。 – Amir

相關問題