Druckbereich auf Autofilterergebnis definieren

[StefanGruber_LA]

Hallo zusammen,

ich möchte in ein Makro gerne die Funktion einfügen, dass nur Zeilen gedruckt, die aus einem Autofilter resultieren.

Hierzu habe ich die gleb geschriebene Zeile eingefügt. Leider gibt es hier aber eine Fehlermeldung.

Kann mir hier jemand weiter helefen? Danke sehr!


Selection.AutoFilter
    Range("A11:AC1500").Select
    Selection.AutoFilter

    ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
        "-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
        
    Selection.SpecialCells(xlCellTypeVisible).EntireRow.Address
    
    Dim MyMessage As Object, MyOutApp As Object
    Dim SavePath As String
    Dim AWS As String

--> geht dann weiter mit Versand pdf-Datei aus Outlook ...

[IchBinIch]

Hi,

probier es mal so.

Code:

Sub NurSichtbareDrucken()
Dim Bereich As Range

With Tabelle1
    If .FilterMode = True Then
    
        Set Bereich = .Range("A11").CurrentRegion
        Bereich.PrintOut
    
    End If
End With
End Sub

Gruß
Ich

[StefanGruber_LA]

probier es mal so.

Hi Du,

ich habe "Tabelle1" natürlich ersetzt durch die Bezeichnung "Masterliste" meines Sheets.

Leider bringt er mir aber eine Fehlermeldung. Im Debugger wird If.FilterMode = True Then markiert.

Code:

If .FilterMode = True Then

[IchBinIch]

Hi,

verwende Deinen Code oben und statt Deiner gelben Codezeile fügst Du

Code:

Call NurSichtbareDrucken

ein.

Gruß
Ich

[IchBinIch]

... und noch etwas ist mir gerade aufgefallen.

Du willst den Druckbereich festelegen und nicht drucken! Was mein kleines Macro macht. Das hatte ich überlesen. Sorry dafür:

Also wie forlgt.

Code:

Sub NurSichtbareAlsDruckbereich()
Dim Bereich As Range

With Sheets("Masterliste")
   If .FilterMode = True Then
   
       Set Bereich = .Range("A11").CurrentRegion
       .PageSetup.PrintArea = Bereich
   
   End If
End With
End Sub

Gruß
Ich

[StefanGruber_LA]

Das bringt leider nichts!

Fehler beim Kompilieren: Sub oder Function nicht definiert

VG
Stefan

[IchBinIch]

...


Selection.AutoFilter
    Range("A11:AC1500").Select
    Selection.AutoFilter

    ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
        "-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
        
    Selection.SpecialCells(xlCellTypeVisible).EntireRow.Address
    
    Dim MyMessage As Object, MyOutApp As Object
    Dim SavePath As String
    Dim AWS As String

--> geht dann weiter mit Versand pdf-Datei aus Outlook ...

Ich bin davon ausgegangen, Du hättest oben nur einen Codeauszug eingefügt. Das scheint aber nicht der Fall zu sein.
In Deinem Code oben fehlt mind. ein

Code:

Sub xxx()

'Der eigentliche Code

End Sub

Stell doch bitte einmal Deinen kompletten Code ein.

Gruß
Ich

Ergänzung:
Oder besser noch (D)eine Beispieldatei mit anonymisierten Daten.

[StefanGruber_LA]

Das ist der gesamte Code! Das Sheet kann ich leider nicht einfügen, da hier sensible Daten enthalten sind.

VG
Stefan

Private Sub CommandButton3_Click()

    ActiveSheet.Unprotect "abc"
    
    Selection.AutoFilter
    Range("A11:AC1500").Select
    Selection.AutoFilter

    ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
        "-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
    
    Call NurSichtbareDrucken
    
    Dim MyMessage As Object, MyOutApp As Object
    Dim SavePath As String
    Dim AWS As String
    
    AWS = "Z:\Prj\S\StructKurt\Masterlisten\Masterliste.pdf"

    'InitializeOutlook = True
    Set MyOutApp = CreateObject("Outlook.Application")
    'Nachrichtenobject erstellen
    Sheets("Masterliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:="Z:\Prj\S\StructKurt\Masterlisten\Masterliste.pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        .To = "alle"
        .Subject = "Masterliste" & " " & Date & " " & Time
        'Hier wird die temporär gespeicherte Datei als
        'Attachment zugefügt
        .attachments.Add AWS
        'Hier wird eine normale Text Mail erstellt
        'Hier wird die HTML Mail erstellt
        .HTMLBody = "Hallo zusammen," & _
        "

" & _
        "anbei die tägliche Masterliste." & _
        "

" & _
        "Gruß" & _
        "

" & _
        "Team alle"
        
        'Hier wird die Mail nochmals angezeigt
        .display
        'Hier wird die Mail gleich in den Postausgang gelegt
        '.Send
        'Hier wird die temporäre Datei wieder gelöscht
        Kill AWS
        
    Selection.AutoFilter
    Range("A11:AC1500").Select
    Selection.AutoFilter
    
    ActiveWorkbook.SaveCopyAs "Z:\Prj\S\StructKurt\Masterlisten\ " & ActiveSheet.Name & "_" & Format(Now, "yymmdd_hhmm") & ".xlsm"
    
    Range("F12:F1500").Copy
    Range("G12").PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    
    ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
    "-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
    
    Range("D1").Select
    
    End With
    
        Dim wsh As Worksheet
    
            Password = "abc"
            Contents = False
            AllowFormattingCells = False
            AllowFormattingColumns = False
            AllowFormattingRows = False
            AllowInsertingColumns = False
            AllowInsertingRows = False
            AllowInsertingHyperlinks = True
            AllowDeletingColumns = False
            AllowDeletingRows = False
            AllowSorting = True
            AllowFiltering = True
            AllowUsingPivotTables = False
            AllowFormattingObjects = True
    
    ActiveWorkbook.Save

End Sub

[IchBinIch]

Hallo Stefan,

dann teste das bitte einmal:

Code:

Option Explicit
Sub AutoFilterEinschalten()
Dim Filterrange As Range

With Sheets("Masterliste")
Set Filterrange = .Range("A11:AC1500")
   
   If Not .AutoFilterMode = True Then
       .Range("A11").AutoFilter
   End If
 
Filterrange.AutoFilter Field:=2, Criteria1:=Array("-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
   
End With

Call NurSichtbareAlsDruckbereich

End Sub

Sub NurSichtbareAlsDruckbereich()
Dim Bereich As Range

With Sheets("Masterliste")
  If .FilterMode = True Then
 
      Set Bereich = .Range("A11").CurrentRegion
      .PageSetup.PrintArea = Bereich.Address
 
  End If
End With
End Sub

Den Rest Deiner Codes musst Du dann wieder einfügen. Das habe ich auch nicht getestet.
Es sei mir noch eine Randbemerkung gestattet.
Variablen dimensioniert man immer am Anfang einer Prozedur. Das macht die ganze Geschichte etwas übersichtlicher.

Gruß
Ich

[schauan]

Hallo Stefan,

mal zur Ursache von Fehlern. Wenn es einen oder mehrere gibt, ist zur Analyse wichtig, welche und wo sie aufgetreten sind.

Mal unabhängig davon ob die Zeile gebraucht wird - Du hast diesen Code ganz alleine für sich stehen,
Selection.SpecialCells(xlCellTypeVisible).EntireRow.Address
und Excel weiß nicht, wo es das Ergebnis hinpacken soll.

Daher kommt auch in dieser Zeile ein "Fehler 438, Objekt unterstützt diese Eigenschaft oder Methode nicht". Korrekt wäre, dass Du das Ergebnis z.B. einer Variable zuweist, z.B.
strVisAddr = Selection.SpecialCells(xlCellTypeVisible).EntireRow.Address