Filtern nach Eingabe

Hallo Steffen,
die Liste wie sie für eine Combobox-Auswahl erstellt wird, kann man natürlich in einer zweiten Schleife abarbeiten, um den Autofilter zu setzen und die PDF-Dateien erzeugen. Wie man diese Liste erstellt. ist dann sekundär. Es gibt aber elegantere Lösungen als 2 geschachtelte For-Next-Schleifen um eine Liste ohne Duplikate zu erstellen.
Nachfolgend ein Beispiel, wie es mit FreePDF als PDF-Drucker umsetzen könnte.
Gruß
Franz


Sub PrintPDF_Files()
Dim bolVorhanden As Boolean, Zeile As Long, ListZeile As Long
Dim arrProdukt() As String, lngCount As Long
Dim feg As Long, strMsg As String
Dim wkstemp As Worksheet, oFilter As Filter, Druckermerken As String
Dim sDateiname As String, wbPrint As Workbook
Dim sPrintNeu As String, strPrintFile As String
feg = ThisWorkbook.Worksheets("system").Range("E12").Value
MsgBox feg
Set wkstemp = Worksheets("temp")
sDateiname = wkstemp.Parent.FullName
Set wbPrint = wkstemp.Parent
If wbPrint.Saved = False Then wbPrint.Save
With wkstemp
'ggf. alle Daten anzeigen
If .AutoFilterMode = True Then
For Each oFilter In .AutoFilter.Filters
If oFilter.On = True Then
.ShowAllData
Exit For
End If
Next
End If
'Liste der Filter aus gewählter Spalte erstellen
ReDim arrProdukt(0 To 0)
For Zeile = 5 To .Cells(.Rows.Count, feg).End(xlUp).Row
'falls vor-/nachgestellte Leerzeichen in den Zellwerten vorhanden sind, _
dann müssen diese für das Filtern beseitigt werden.
.Cells(Zeile, feg) = Trim(.Cells(Zeile, feg).Text)
If .Cells(Zeile, feg).Value  "" Then
If arrProdukt(0) = "" Then
arrProdukt(0) = .Cells(Zeile, feg).Text
strMsg = arrProdukt(0)
Else
'Prüfen ob Händler schon in Auswahlliste
bolVorhanden = False
For ListZeile = 0 To lngCount
If arrProdukt(ListZeile) = .Cells(Zeile, feg).Text Then
bolVorhanden = True
Exit For
End If
Next
If bolVorhanden = False Then
lngCount = lngCount + 1
ReDim Preserve arrProdukt(0 To lngCount)
arrProdukt(lngCount) = .Cells(Zeile, feg).Text
If lngCount  "" Then VBA.Kill strPrintFile
'temporären Dateinamen merken für nächsten Löschaufruf
strPrintFile = wbPrint.FullName
'Blatt drucken
.PrintOut
End With
Next
.ShowAllData
Application.ActivePrinter = Druckermerken
'Originaldatei wieder öffnen
Workbooks.Open sDateiname
'tempräre Druckdatei schließen und löschen
wbPrint.Close savechanges:=False
End If
End With
End Sub
Function fncZeichenRaus(ByVal sDateiname As String) As String
'Sonderzeichen und Punkt im Produktnamen durch "_" ersetzen
Dim vZeichen, iI As Long
vZeichen = Array(":", "", "|", "\", "/", ".", "[", "]", "?", "*")
For iI = LBound(vZeichen) To UBound(vZeichen)
sDateiname = VBA.Replace(sDateiname, vZeichen(iI), "_")
Next
fncZeichenRaus = sDateiname
End Function

Hallo Steffen,
den E-Mail-Versand der PDF-Datei direkt in die Druck-Prozedur einzubinden könnte Probleme bereiten, da die PDF-Datei evtl. noch nicht vom PDF-Programm fertiggestellt ist, aber schon als Anhang versendet werden soll.
Du solltest die Namen der Händler, die E-Mail-Adressen und die Namen der zugehörigen erstellten PDF-Dateien in einem separaten Tabelenblatt für den Email-Versand erfassen. Alternativ kannst du auch ein 3-spaltiges als Public dehlariertes DatenArray anlegen.
Diese Daten kannst dann in einer Userform als Basis für eine Listbox mit 3 Spalten verwenden. Die Listbox muss du so einrichten, dass Multiselection möglich ist.
In der Listbox markierst du dann die Händler an die eine Datei verschickt werden soll.
Zum E-mail-Versand prüfst du dann die Selected-Eigenschaft der Listeneinträge und verschickst abhängig davon die Dateien.
Die Umsetzung in ein VBA-Projekt sprengt hier aber den Rahmen.
Für die Suche der E-mail-Adressen der Händler kannst du die Find-Methode verwenden. Siehe nachfolgendes Beispiel.
Gruß
Franz

Sub aaTest()
Dim sEMail As String, sName As String
sName = "Renft" 'testwert
'E-Mail-Adresse des Händlers suchen
sEMail = FindeHaendlerEMail(sHaendlerName:=sName)
If sEMail = "" Then
MsgBox "Händler """ & sName & """ nicht gefunden im Blatt System"
Else
MsgBox "Händler """ & sName & "  E-Mail-Adresse: " & sEMail 'testzeile
'Mail - Versand
End If
End Sub
Function FindeHaendlerEMail(sHaendlerName) As String
Dim wks As Worksheet, Zelle As Range
Set wks = Worksheets("System") 'Blatt mit E-Mail-Adressen
'Händlername in Spalte 6 (F) suchen
Set Zelle = wks.Columns(6).Find(What:=sHaendlerName, LookIn:=xlValues, lookat:=xlWhole,  _
MatchCase:=False)
If Zelle Is Nothing Then
FindeHaendlerEMail = ""
Else
FindeHaendlerEMail = Zelle.Offset(0, 1).Text
End If
End Function

Forumthread: Filtern nach Eingabe

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Filtern und Drucken in Excel: Automatisierung leicht gemacht

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)