Avatar billede brianmilan Juniormester
29. november 2007 - 13:05 Der er 11 kommentarer og
1 løsning

Hente filnavn ind i en dropdownliste.

Hej,

Kan man lave en dropdownliste i Excel hvor den hvis alle de filer der ligger i en bestemt mappe? og når man så markere et filnavn på droplisten skal den hive filnavet med tilbage til den celle hvor man trykkede på dropdownlisten...

Tror I at det kan lade sig gøre?  :o)

Venlig hilsen Brian
Avatar billede brianmilan Juniormester
29. november 2007 - 13:10 #1
ups, der skulle stå "Hvor den viser alle de filer..."
Avatar billede supertekst Ekspert
29. november 2007 - 13:45 #2
Hvordan forestiller du dig at dropdown'en defineret - som kontrolelement eller i en Userform?

Men det skulle nok kunne lade sig gøre på den ene eller anden måde.
Avatar billede brianmilan Juniormester
29. november 2007 - 13:50 #3
Hej, meget gerne hvis det kunne være som et kontrolelement.
Avatar billede supertekst Ekspert
29. november 2007 - 14:43 #4
Hvor skulle det markerede filnavn som indsættes?
Avatar billede jlemming Nybegynder
29. november 2007 - 14:48 #5
Denne kode, laver en tabel med alle de *.xls der findes i samme mappe som den åbent fil, såvidt jeg kan se er du nød til at have en knappe til at opdatere den med

I din dropdown kan vælge tabel A2:A1000, og celle resultat i linked celle

Private Sub CommandButton1_Click()
    Dim FS As FileSearch
    Dim FilePath As String, FileSpec As String
    Dim i As Long
    Dim v As Variant
    Dim rTarget As Range
    Dim ToSheet As Worksheet
    Dim Data As Variant
    '******************************
    FilePath = "\\"
    'FilePath = "D:\Documents and Settings\jml\My Documents"
    FileSpec = "*.xls"
    Set ToSheet = ThisWorkbook.Worksheets("sheet1")
    '******************************
    'find excel filerne
    Set FS = Application.FileSearch
    With FS
        .LookIn = FilePath
        .Filename = FileSpec
        .SearchSubFolders = False          'skal underfoldere også søges
        .Execute
        If .FoundFiles.Count = 0 Then
            MsgBox ("Ingen filer fundet")
            Exit Sub
        End If
    End With
    Range("A1:A1000").ClearContents
    Range("A1") = "antal filer:"
    Range("B1") = FS.FoundFiles.Count
    For i = 1 To FS.FoundFiles.Count
        Set rTarget = ToSheet.Range("A1000").End(xlUp).Offset(1, 0)
        For t = 1 To Len(FS.FoundFiles(i))
            If Mid(FS.FoundFiles(i), t, 1) = "\" Then sidst = t
        Next t
        rTarget.Offset(0, 0) = Mid(FS.FoundFiles(i), sidst + 1, Len(FS.FoundFiles(i)) - sidst)
    Next i
End Sub
Avatar billede jlemming Nybegynder
29. november 2007 - 14:53 #6
Denne opdatere liste hvergang musen kommer over dropdown

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Call listefil
End Sub

Private Sub listefil()
    Dim FS As FileSearch
    Dim FilePath As String, FileSpec As String
    Dim i As Long
    Dim v As Variant
    Dim rTarget As Range
    Dim ToSheet As Worksheet
    Dim Data As Variant
    '******************************
    FilePath = "\\"
    'FilePath = "D:\Documents and Settings\jml\My Documents"
    FileSpec = "*.xls"
    Set ToSheet = ThisWorkbook.Worksheets("sheet1")
    '******************************
    'find excel filerne
    Set FS = Application.FileSearch
    With FS
        .LookIn = FilePath
        .Filename = FileSpec
        .SearchSubFolders = False          'skal underfoldere også søges
        .Execute
        If .FoundFiles.Count = 0 Then
            MsgBox ("Ingen filer fundet")
            Exit Sub
        End If
    End With
    Range("A1:A1000").ClearContents
    Range("A1") = "antal filer:"
    Range("B1") = FS.FoundFiles.Count
    For i = 1 To FS.FoundFiles.Count
        Set rTarget = ToSheet.Range("A1000").End(xlUp).Offset(1, 0)
        For t = 1 To Len(FS.FoundFiles(i))
            If Mid(FS.FoundFiles(i), t, 1) = "\" Then sidst = t
        Next t
        rTarget.Offset(0, 0) = Mid(FS.FoundFiles(i), sidst + 1, Len(FS.FoundFiles(i)) - sidst)
    Next i
End Sub
Avatar billede jlemming Nybegynder
29. november 2007 - 14:59 #7
aah, den sidste dur hvis ikke :-)
Avatar billede brianmilan Juniormester
29. november 2007 - 15:13 #8
supertekst> Det markerede filnavn må gerne indsættes i den celle, hvor man vælger filnavnet fra.
Avatar billede brianmilan Juniormester
29. november 2007 - 15:17 #9
Tak jlemming, jeg prøver den lige :-)
Avatar billede jlemming Nybegynder
29. november 2007 - 15:43 #10
Det passer ikke helt det jeg skrev, den tager standard bibliotektet, denne her tager den folder som den nuværende fil er gemt i

Sub filliste()
    Dim FS As FileSearch
    Dim FilePath As String, FileSpec As String
    Dim i As Long, t As Integer
    Dim v As Variant
    Dim rTarget As Range
    Dim ToSheet As Worksheet
    '******************************
    'FilePath = "\\"
    FilePath = ThisWorkbook.Path
    'FilePath = "D:\Documents and Settings\jml\My Documents"
    FileSpec = "*.xls"
    Set ToSheet = ThisWorkbook.Worksheets("sheet1")
    '******************************
    'find excel filerne
    Set FS = Application.FileSearch
    With FS
        .LookIn = FilePath
        .Filename = FileSpec
        .SearchSubFolders = False          'skal underfoldere også søges
        .Execute
        If .FoundFiles.Count = 0 Then
            MsgBox ("Ingen filer fundet")
            Exit Sub
        End If
    End With
    Range("A1:A1000").ClearContents
    Range("A1") = "antal filer:"
    Range("B1") = FS.FoundFiles.Count
    For i = 1 To FS.FoundFiles.Count
        For t = 1 To Len(FS.FoundFiles(i))
            If Mid(FS.FoundFiles(i), t, 1) = "\" Then sidst = t
        Next t
        ToSheet.Range("A1").Offset(i, 0) = Mid(FS.FoundFiles(i), sidst + 1, Len(FS.FoundFiles(i)) - sidst)
    Next i
End Sub
Avatar billede brianmilan Juniormester
03. december 2007 - 10:50 #11
Hej jlemming, mange tak for hjælpen :-)  Kunne jeg få dig til at lægge et svar, så vil jeg give dig point :-)
Avatar billede jlemming Nybegynder
03. december 2007 - 13:03 #12
Ingen problemer :o), velbekomme
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester