1

エクセル初心者です。以下のようなものが必要です。

ユーザーがセルをクリックするか、セルに入力すると:

  1. ファイルウィンドウを自動的に開閉する必要があります。

  2. ユーザーがファイルを選択すると、パス/ファイル名を取得してセルに入れる必要があります。c:\folder1\file1.ext

  3. ユーザーが複数のファイルを選択した場合、すべてのパス/ファイル名を|区切り文字としてセルに取得する必要があります。お気に入りc:\folder1\file1.ext|d:\folder2\file2.ext

  4. ユーザーがセルをクリックするか、セルにもう一度入力すると、既存のパス/ファイル名を保持し、3 番のように他のパス/ファイル名をそれらに追加できるようにする必要があります。

4

2 に答える 2

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したり、ターゲット範囲の名前を決定する方法を見つけたりすることができます (それほど難しくありません)。

ワークシートがロックされていない場合、クリックされたセルはフォーカスを維持し、少し面倒な編集モードになります。セルをロックすると、以前のバージョンの Excel でこれが修正されました (ただし、v.2010 以降では機能しないと思います)。

モジュール (getList) 内のコードはほぼ同じままでかまいません (必須ではありませんが、複数のファイルを処理するすべてのコードを削除したい場合もあります)。1 行のコードを追加するだけです。

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

これがお役に立てば幸いです。あなたが求めていたことを理解しました!

于 2012-12-16T00:52:14.587 に答える
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
于 2012-12-16T00:36:40.897 に答える