AW: ORDNER IN COMBOBOX AUSWÄHLEN
26.04.2007 23:19:48
fcs
Hallo Ralph,
folgende Code-Anpassung (ohne Gewähr für Funktion, da ich nicht den gedamten Code testen konnte) sollte die Verzeichnisse in der Auswahlliste anzeigen und beim Druck dann die entsprechende Exceldateiliste abarbeiten. Das Sortieren der Auswahlliste hab ich als Goody ergänzt und mich dabei einer anderen Quelle hier im Forum bedient.
Also erst einmal in einer Kopie der Datei probieren ob es funktioniert.
Evtl. gibt es eine elegantere Methode die Liste der Unterverzeichnisse eines Ordners zu ermitteln. Mir ist im Moment aber nichts besseres eingefallen, als via Dir zunächst eine Liste mit Unterverzeichnissen und Dateien zu erzeugen und aus dieser dann in einer Schleife die Unterverzeichnisse heraudzufischen. Dabei hab ich die Tatsache ausgenutzt, dass bei Dateien Dir immer den Dateinamen zurückgibt, während bei Unterverzeichnissen ein Leerstring oder ein Dateiname als Wert zurückgegeben wird.
Gruß
Franz
Private pstrPfad As String
Private Sub cmdPrint_Click()
Dim wb As Workbook, lstrFile
'Prüfen ob in der Verzeichnis ausgewählt wurde
If pstrPfad = "" Or Combobox1.Value = "" Then
MsgBox "Es wurde noch kein Verzeichnis ausgewählt"
Exit Sub
End If
lstrFile = Dir(pstrPfad & Combobox1.Value & "\*.xls")
'Alle XLS-Dateien im Unterverzeichnisse öffnen und Drucken
Do Until lstrFile = ""
'Datei öffnen
Set wb = Workbooks.Open(FileName:=pstrPfad & Combobox1.Value & "\" & lstrFile)
'die nächste Befehlszeile druckt die ausgewählten Datei 3x
'und zwar die ganze Arbeitsmappe
wb.PrintOut Copies:=3, Preview:=False, Collate:=True
'die gedruckte Datei wird wieder geschlossen
' wb.Close savechanges:=False 'Datei nach dem Drucken ohne Speichern schließen
wb.Close savechanges:=True 'Datei nach dem Drucken speichern und schließen
lstrFile = Dir
Loop
Set wb = Nothing
End Sub
Private Sub ComboBox1_Change()
If Combobox1.Text "" Then
cmdPrint.Enabled = True
Else
cmdPrint.Enabled = False
End If
End Sub
Private Sub CommandButton2_Click()
Unload Ausgeben2
UserForm13.Show
End Sub
Private Sub CommandButton3_Click()
Unload Ausgeben2
UserForm4.Show
End Sub
Private Sub CommandButton4_Click()
Verzeichnissuchen
CmbFill
End Sub
Private Sub UserForm_Activate()
Dim lstrFile As String, Dateien() As String, i As Integer
pstrPfad = "C:\Mandantenbriefe\"
lstrFile = Dir(pstrPfad, vbDirectory)
'Alle Dateien und Unterverzeichnisse in eine Feld-Variable einlesen
i = 0
Do Until lstrFile = ""
ReDim Preserve Dateien(i)
Dateien(i) = lstrFile
lstrFile = Dir
i = i + 1
Loop
'Unterverzeichnis herauspicken und in Auswahlliste einfügen
Combobox1.Clear
For i = LBound(Dateien) To UBound(Dateien)
If Not (Dateien(i) = "." Or Dateien(i) = "..") Then
If Dir(pstrPfad & Dateien(i)) Dateien(i) Then
Combobox1.AddItem Dateien(i)
End If
End If
Next
'Einträge in ComboBox1 sortieren
Call SortBox(Combobox1, 1, 1, 1)
End Sub
Public Sub SortBox(cltBox As Control, intSpalten As Integer, _
intSpalte As Integer, Optional bytWie As Byte = 1)
' So DIS 28.04.05
' SortBox sortiert nicht gebundene List- und Comboboxen. Gebundene List- und Comboboxen
' (Angabe bei RowSource oder ListFillRange) können NICHT sortiert werden.
' cltBox : Name der Listbox die sortiert werden soll.
' intSpalten : Wieviele Spalten sollen mit sortiert werden. Sollte der Anzahl der Spalten
' in der Listbox entsprechen
' intSpalte : Nach welcher Spalte soll sortiert werden.
' bytWie : 1 oder Nicht angegeben als Text
' : 2 als Zahl, dann muß die ganze Spalte Zahlen enthalten.
' : 3 als Datum, dann muß die ganze Spalte Datumwerte enthalten.
' Aufruf zum Beispiel so: ListBox1 mit 7 Spalten, Sortierung nach Spalte 1 Sortierordnung Text
' SortBox ListBox1, 7, 1 oder SortBox ListBox1, 7, 1, 1
' Oder so : Listbox17 mit 2 Spalten, Sortierung nach Spalte 2 Sortierordnung Zahlen
' SortBox ListBox17, 2, 2, 2
Dim intLast As Integer, intNext As Integer, intCounter As Integer, intFehler As Integer
Dim strTmp As String, strFehlertext As String
Dim variLast As Variant, variNext As Variant
On Error GoTo Errorhandler
intFehler = 0
With cltBox
For intLast = 0 To .ListCount - 1
For intNext = intLast + 1 To .ListCount - 1
Select Case bytWie
Case 1
intFehler = 0
variLast = CStr(.List(intLast, intSpalte - 1))
variNext = CStr(.List(intNext, intSpalte - 1))
Case 2
intFehler = 1
variLast = CDbl(.List(intLast, intSpalte - 1))
variNext = CDbl(.List(intNext, intSpalte - 1))
Case 3
intFehler = 2
variLast = CDate(.List(intLast, intSpalte - 1))
variNext = CDate(.List(intNext, intSpalte - 1))
End Select
intFehler = 0
If variLast > variNext Then
For intCounter = 0 To intSpalten - 1
strTmp = CStr(.List(intLast, intCounter))
.List(intLast, intCounter) = CStr(.List(intNext, intCounter))
.List(intNext, intCounter) = strTmp
Next intCounter
End If
Next intNext
Next intLast
End With
Exit Sub
Errorhandler:
Select Case intFehler
Case 0
strFehlertext = "In der Listbox Sortierung ist ein Fehler aufgetreten !"
Case 1
strFehlertext = "Nicht alle Werte in der zu sortierenden Spalte sind Zahlen !"
Case 2
strFehlertext = "Nicht alle Werte in der zu sortierenden Spalte sind Datumswerte !"
Case Else
strFehlertext = "Unerwarteter Fehler !"
End Select
MsgBox strFehlertext & " Bitte informieren Sie 'So' ! " & vbCr & vbCr & _
"Fehler aufgetreten in " & cltBox.Name & " !" & vbCr & _
"Fehlernummer = " & Err.Number & vbCr & _
"Fehlerbeschreibung = " & Err.Description & vbCr & _
"Fehlersource = " & Err.Source, vbCritical, " Meldung vom Makro SortBox !"
End Sub