Combox in Userform verlinken
01.11.2006 08:45:37
Matthias
ich habe folgendes Problem:
Ich möchte gern eine combobox in eine userform integrieren und diese mit Datein füllen, die auf einem anderen Laufwerk stehen. Bisher klappte es ganz gut, da ich die combobox nicht in einer userbox integriert hatte und das sah so aus:
Sub Workbook_Open()
'Variablen
Dim blatt_produktplattform As String
Dim blatt_datenbank As String
Dim combobox_name As String
Dim i As Integer
Dim pfad As String
Dim dateiname() As String
Dim teile As Integer
'-----
blatt_produktplattform = "Produktplattform"
blatt_datenbank = "Datenbank"
'Die ComboBoxen dynamisch mit dem Inhalt der jeweiligen Ordner fuellen
For i = 1 To Worksheets(blatt_datenbank).Range("A65536").End(xlUp).Row Step 1
combobox_name = Worksheets(blatt_datenbank).Cells(i, 1)
pfad = Worksheets(blatt_datenbank).Cells(i, 2)
Worksheets(blatt_produktplattform).OLEObjects.Item(combobox_name).Object.Clear
'Wenn in der Variable pfad kein Pfad zu einem Verzeichnis steht sondern direkt zu eienr Datei
If FileExists(pfad) = False Then
'Sucht alle Dateien in dem Verzeichnis
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(pfad)
Set fc = f.Files
For Each f1 In fc 'Schreibt Name aller Dateien in die jeweilige ComboBox
Worksheets(blatt_produktplattform).OLEObjects(combobox_name).Object.AddItem f1.Name
Next
Else
'Schreibt spezifizierten Dateinamen in die ComboBox
dateiname() = Split(pfad, "\")
teile = UBound(dateiname)
Worksheets(blatt_produktplattform).OLEObjects(combobox_name).Object.AddItem dateiname(teile)
End If
'Style der ComboBox definieren
Worksheets(blatt_produktplattform).OLEObjects(combobox_name).Object.Style = fmStyleDropDownList
Worksheets(blatt_produktplattform).OLEObjects(combobox_name).Object.BoundColumn = 0
Worksheets(blatt_produktplattform).OLEObjects(combobox_name).Object.ListIndex = -1
Next i
End Sub
Public Function FileExists(strPath As String) As Boolean 'FileExists empfaengt den absoluten Pfad zu einer Datei und ueberprueft ob dieses existiere (Rueckgabewert: True od. False)
On Error Resume Next
FileExists = ((GetAttr(strPath) And (vbDirectory Or vbVolume)) = 0)
End Function
Option Explicit
Function file_open(combobox As String, datei As String) 'Öffnet eine Datei die sich im Pfad der jeweiligen ComboBox befindet
'Variabeln
Dim endung() As String
Dim dateiname() As String
Dim blatt_datenbank As String
Dim zeile As Integer
Dim pfad As String
'---------
blatt_datenbank = "Datenbank"
zeile = Worksheets(blatt_datenbank).Range("A1:A65536").Find(combobox).Row
pfad = Worksheets(blatt_datenbank).Cells(zeile, 2)
endung = Split(datei, ".")
'Ueberpruefung ob der Eintrag ein Pfad zu einem Verzeichnis oder direkt zu einer Datei ist
dateiname() = Split(pfad, "\")
If dateiname(UBound(dateiname)) = datei Then
Else
pfad = pfad & "\" & datei
End If
'-
'Wenn die Datei eine *.pdf Datei ist...
If endung(UBound(endung)) = "pdf" Then
Shell "C:\Programme\Adobe\Acrobat 6.0\Reader\AcroRd32.exe """ & pfad & """", vbMaximizedFocus
End If
'Wenn die Datei eine *.doc Datei ist...
If endung(UBound(endung)) = "doc" Then
Shell "winword.exe """ & pfad & """", vbMaximizedFocus
End If
'Wenn die Datei eine *.rtf Datei ist...
If endung(UBound(endung)) = "rtf" Then
Shell "winword.exe """ & pfad & """", vbMaximizedFocus
End If
'Wenn die Datei eine *.xls Datei ist...
If endung(UBound(endung)) = "xls" Then
Workbooks.Open Filename:=pfad
End If
'Wenn die Datei eine *.ppt Datei ist...
If endung(UBound(endung)) = "ppt" Then
Shell "powerpnt.exe """ & pfad & """", vbMaximizedFocus
End If
End Function
Private Sub Tiberius_Click()
Dim datei As String
Dim combobox As String
Dim ok As String
combobox = "Tiberius"
datei = Tiberius.List(Me.Tiberius.Value)
ok = file_open(combobox, datei)
End Sub
Wie bekomme ich das hin, dass es mit der userform auch funktioniert?
Vielen Dank
Matthias