wie mache ich es mit zwei Userformen
02.11.2006 17:18:54
Matthias
hatte Gestern im Forum eine Frage gestellt, die mir auch beantwortet wurde. Nun möchte ich dieses allerdings mit zwei Userformen durchführen. Wenn ich quasi den code identisch wiederhole bzw. ihn anpasse für eine zweite Userfrom, dann wird immer angezeigt Objekt kann nicht gefunden werden und der Debugger springt zu der Verlinkung cmd / frm.
Der Grund dafür ist, wenn ich im Daten Blatt mehr als einen Eintrag stehen habe.
Hier der Code von Gestern:
Hallo Mathias,
die Workbook_Open-Prozedur muss du dann angepasst als Initialisierungs-Prozedur des Userforms anlegen.
Falls du beim Öffnen der Datei direkt das Userform angezeigt bekommen möchtest, dann passt du diese entsprechend an mit
Private Sub Workbook_Open()
UserForm1.Show
End Sub
Für das Userform muss du die Prozeduren wie folgt verschieben/anpassen:
Gruss
Franz
Die folgenden beiden Prozeduren unter dem Userform einfügen
Option Explicit
Private Sub UserForm_Initialize()
'Variablen
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_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)
Me.Controls(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
Me.Controls(combobox_name).Object.AddItem f1.Name
Next
Else
'Schreibt spezifizierten Dateinamen in die ComboBox
dateiname() = Split(pfad, "\")
teile = UBound(dateiname)
Me.Controls(combobox_name).Object.AddItem dateiname(teile)
End If
'Style der ComboBox definieren
Me.Controls(combobox_name).Object.Style = fmStyleDropDownList
Me.Controls(combobox_name).Object.BoundColumn = 0
Me.Controls(combobox_name).Object.ListIndex = -1
Next i
End Sub
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
für jede weitere Combobox mit Dateiauswahl eine gleichartige Clickprozedur einfügen
Die folgenden beiden Prozeduren in ein allgemeines Modul einfügen, bzw. dorthin verschieben
Option Explicit
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
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
Vielen Dank für Eure Hilfe
Gruß
Matthias