Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1148to1152
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Filtern nach Eingabe
Steffen
Guten Morgen. Ich tüftle seit ner Weile an folgendem Sachverhalt:
Ich möchte eine Tabelle nacheinander nach allen Werte einer Spalte filtern und als PDF-Drucken. Die Spaltennummer in der gefiltert wird, steht unter
Code:
feg = ThisWorkbook.Worksheets("system").Range("E12").Value
und die Zeile, ab der gefiltert werden soll ist 5.
Ich habe folgenden Code um eine Combobox mit den Werten (ohne Duplikate) der entsprechend in
Code:
feg = ThisWorkbook.Worksheets("system").Range("E12").Value
hinterlegten Spalte zu füllen. Diesen Code könnte man doch auch als Schleifenvorlage fürs PDF Drucken wählen oder hab ich da einen Denkfehler. man könnte sicherlich nach dem arrProdukt filtern?!?! Allerdings gibt mir
Code:
msgbox arrProdukt
einen Laufzeitfehler 13 heraus.
Hier also der Code zum Füllen der ComboBox:
Code:
feg = ThisWorkbook.Worksheets("system").Range("E12").Value
MsgBox feg
Dim bolVorhanden As Boolean, Zeile As Long, ListZeile As Long
Dim arrProdukt() As String, lngCount As Long
With wkstemp
ReDim arrProdukt(0 To 0)
For Zeile = 5 To .Cells(.Rows.Count, feg).End(xlUp).Row
If .Cells(Zeile, feg).Value "" Then
If arrProdukt(0) = "" Then
arrProdukt(0) = Trim(.Cells(Zeile, feg).Text)
Else
'Prüfen ob Händler schon in Auswahlliste
bolVorhanden = False
For ListZeile = 0 To lngCount
If arrProdukt(ListZeile) = Trim(.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) = Trim(.Cells(Zeile, feg).Text)
End If
End If
End If
Next
End With
With Me.cob_einzelfilter
.List = arrProdukt()
End With
Achso: die Spaltenzahl der Filterspalte ändert sich je nach Eingabe. bleibt also nicht zwangsläufig gleich.
Ich hoffe, es ist halbwegs verständlich und jemand hat nen kleinen Anstoss!
Das Quellarbeitsblatt nennt sich "temp"
Gruß und Danke Steffen

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Filtern nach Eingabe
07.04.2010 17:24:27
ChristianM
Hallo,
Allerdings gibt mir "msgbox arrProdukt" einen Laufzeitfehler 13 heraus.
Ja klar, is' ja auch e'n Array und kein String.
Wenn du einzelne Werte des Array abfragen willst, dann zB mit "arrProdukt(0)".
Des Weiteren ist es müßig, deinen halben Code ohne Anfang und und ohne Ende nach zu vollziehen.
Aber nimm doch statt dem Array einfach einen Hash - auch bekannt als Dictionary ...
Gruß
Christian
AW: Filtern nach Eingabe + PDF erstellen
07.04.2010 20:05:51
fcs
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

Anzeige
AW: PDF erstellen und einzeln versenden
08.04.2010 12:07:19
Steffen
Hallo nochmal. Also der Export klappt super. hab noch einiges angepasst, jetzt klappts.
Danke Vielmals dafür!
https://www.herber.de/bbs/user/68974.xls
Schau Dir mal bitte die Datei an, wie lautet der Befehl/die Befehle um nach den Händlern zu filtern (das hab ich ja) UND die Datei im PDF Format an die die Händler zu senden. (die Mailadressen für jeden Händler stehen im "system" Tabellenblatt. Es muss aber unterschieden werden (zum Beispiel durch ne UserForm), ob der Export und Versand für ALLE Händler oder nur für Einige gemacht werden sollen.
Ich bekomme nicht hin, den Mailversand hinter den Ausdruck als PDF zu basteln, weil er dann bei mir zwischen den modulen hin und her springt und bemängelt, dass ein "Next ohne For" existiert. Vermutlich weil er in der Schleife hin und her springt.

Also: Problem: Ich weiss nicht, wie ich ihm sagen kann: "Der Händler, nach dem Du gerade filterst; Suche von ihm im Tab.Blatt "system" die zugehörige, rechts danebenstehende Mailadresse heraus und durchlaufe die Sendeprozedur (Outlook). Erst dann den nächsten Eintrag wählen."

hat da jemand Rat?
Anzeige
AW: PDF erstellen und einzeln versenden
08.04.2010 17:31:37
fcs
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

Anzeige
AW: PDF erstellen und einzeln versenden
09.04.2010 08:08:05
Steffen
tausend Dank! Die Eintragung der Händler und der Zugehörigen Mailadressen per Tabellenblatt empfinde ich als für meine Zwecke besser geeignet. Zumal es einfacher funktioniert.
Also tausend Dank, ist genau der Code, den Ich brauche.
Wegen dem Verschicken nach dem Erstellen:
Könnte man nicht eine Wartzeit (wie auch beim Versand der Mails) hineinprogrammieren?
Wie kann ich eine externe Datei, die irgendwo aufm Computer liegt, deren Speicherort im Vorfeld ausgewählt wird, mit VBA als Attachment in eine Mail einfügen?
Das müsste die letzte Hürde sein.
Danke! Klasse....
AW: PDF erstellen und einzeln versenden
09.04.2010 10:53:38
fcs
Hallo Steffen,
suche hier im Forums-Archiv unter "Outlook" oder "Anhang".
Da solltest du Anregungen für den E-Mail-Versand finden.
Ob eine Wartezeit nach jedem Druckvorgang ausreicht, damit das PDF-Programm die Erstellung der Datei abschließen kann, kann ich so nicht sagen, da ich keine Erfahrungen diesbezüglich habe.
Besser ist wahrscheinlich in einer Do-Loop-Schleife zu prüfen, ob die PDF-Datei vorhanden ist und dann den E-Mail-Versand zu starten. Nachfolgend ein Beispiel für die Prüfschleife
Gruß
Franz
Sub Makro1()
Dim sNamePDF As String, sTime As Double
sNamePDF = "C:\Lokale daten\Test\Testschleife.pdf"
'vorhandenen Alt-PDF-Datei ggf. löschen
If Dir(Pathname:=sNamePDF)  "" Then Kill sNamePDF
Application.ActivePrinter = "FreePDF XP auf Ne03:"
ActiveWindow.SelectedSheets.PrintOut
'Warten in Schleife bis PDF-Datei erstellt.
Application.StatusBar = "Warte auf Fertigstellung PDF-Datei"
Do Until Dir(Pathname:=sNamePDF)  ""
Application.Wait Time:=Now + TimeSerial(0, 0, 1) 'Verzögerung 1 Sekunde
sTime = sTime + 1
If sTime > 20 Then
If MsgBox("PDF-Erstellung dauert extrem lange. Abbrechen?", _
vbQuestion + vbYesNo, "Warten auf PDF-Erstellung") = vbYes Then
Application.StatusBar = False
GoTo Weiter01 'Notausgang
Else
sTime = 0
End If
End If
Loop
Application.StatusBar = False
MsgBox sNamePDF & " ist erstellt" 'Testzeile
'Versand der PDF-Datei
Weiter01:
End Sub

Anzeige

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige