VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Vor dem Drucken Spalten ausblenden	22.05.2014 15:24:10	Gast27757
Vor dem Drucken Spalten ausblenden	23.05.2014 15:15:34	Gast94722
Vor dem Drucken Spalten ausblenden	28.05.2014 14:55:01	Gast27757

Ansicht des Beitrags:

Von:
Gast27757

Datum:
22.05.2014 15:24:10

Views:
1625

Rating:

Antwort:

Thema:
Vor dem Drucken Spalten ausblenden

Hallo

Ich habe ein Excelfile, bei dem ich vor dem Drucken gewisse leere Spalten ausblenden möchte. Leider funktioniert der Code nicht immer, sodass auch ausgefüllte Spalten teilweise ausgeblendet werden. Ich kann mir aber nicht erklären, an was es liegen kann, dass die Spalten trotz Eintrag ausgeblendet werden. Kann mir vielleicht jemand sagen, ob ich in meinem Code einen Fehler habe, oder ob man ihn anders schreiben muss?

Zur Erklärung: Es handelt sich um ein Lohnabrechnungsblatt. In die Spalten K bis T werden diverse Arten von Spesen eingetragen. Somit kann innerhalb dieses Bereiches öfters eine Spalte leer oder nur Teilweise ausgefüllt sein. Wenn die Spalte im ganzen Bereich (Zeile 9 - 28) leer ist soll die ganze Spalte vor dem Drucken ausgeblendet werden. Ansonsten, wenn eine, mehrere, oder alle Zellen im Bereich ausgefüllt sind, soll die ganze Spalte vor dem Drucken angezeigt werden.

'Unbenutzte Spalten ausblenden im Bereich K bis T (ohne S)
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If ActiveSheet.Name = "Lohnblatt" Then
        Cancel = True
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        With ActiveSheet
            .Unprotect Password:="FinDK"
            On Error Resume Next
            .Range("K9:K28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("K9:K28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("M9:M28").SpecialCells(xlCellTypeBlanks).EntireColumn(L).Hidden = True
            .Range("M9:M28").SpecialCells(xlCellTypeConstants).EntireColumn(L).Hidden = False
            
            .Range("M9:M28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("M9:M28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("N9:N28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("N9:N28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("O9:O28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("O9:O28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("P9:P28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("P9:P28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("Q9:Q28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("Q9:Q28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("R9:R28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("R9:R28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .Range("T9:T28").SpecialCells(xlCellTypeBlanks).EntireColumn.Hidden = True
            .Range("T9:T28").SpecialCells(xlCellTypeConstants).EntireColumn.Hidden = False
            
            .PageSetup.PrintArea = "A1:T32"
            .PrintOut
            On Error GoTo 0
            .Protect Password:="FinDK"
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

Zur Ergänzung:

Weiter habe ich auf dem Tabellenblatt noch einen Code, der aber einwandfrei funktioniert. Vielleicht stört sich irgendein Code am anderen (?).
Auch hier zur Erklärung: Es gibt verschiedene Abteilungen (B1) bei denen unterschiedliche Spalten angezeigt werden. Wenn die Abteilung ausgewählt ist und ein Name oder Ansatz eingetragen wird, kann die Abteilung nicht mehr geändert werden. Und zum Schluss einige Toggle-Buttons die via Knopfdruck Spalten ein- und ausblenden.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objCell As Range
    On Error GoTo fehler
    With ActiveSheet
        If Intersect(Target, .Range("A1:U38")) Is Nothing Then Exit Sub
        Application.EnableEvents = False
        .Unprotect Password:="FinDK"
        If .Range("B3").Value >= 550000 And .Range("B3").Value <= 570030 And .Range("B1").Value = "HBB LG" Or .Range("B1").Value = "HBB Ex" Then .Columns("E:E").Hidden = False Else .Columns("E:E").Hidden = True
        If .Range("B1") = "IFK Ko" Then .Columns("H:H").Hidden = False Else .Columns("H:H").Hidden = True
        If .Range("B1") = "BQ" Or .Range("B1") = "FI/VAE" Or .Range("B1") = "Admin" Then .Columns("S:S").Hidden = False Else .Columns("S:S").Hidden = True
        If .Range("B1") = "BQ" Or .Range("B1") = "FI/VAE" Or .Range("B1") = "Admin" Then .Rows("2:2").Hidden = True Else .Rows("2:2").Hidden = False
        If .Range("B1") = "Admin" Then .Rows("3:3").Hidden = True Else .Rows("3:3").Hidden = False
        .Range("B4").Value = Format(Date, "DD.MM.YYYY")
        With .Range("B1")
            If Application.WorksheetFunction.CountA(ActiveSheet.Range("B9:B28,F9:F28")) = 0 Or IsEmpty(ActiveSheet.Range("B1")) Then
                .Interior.ColorIndex = xlNone
                .Locked = False
            Else
                With .Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = -0.249946592608417
                    .PatternTintAndShade = 0
                End With
                .Locked = True
            End If
        End With
        .Range("A9:U28").Sort Key1:=.Range("B9"), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        .Protect Password:="FinDK"
    End With
fehler:
    Application.EnableEvents = True
End Sub


'Reisespesen
Private Sub ToggleButton1_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton1
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("K:K").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("K:K").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub
'Autospesen
Private Sub ToggleButton2_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton2
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("L:M").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("L:M").EntireColumn.Hidden = True
        End If
    End With
    ActiveSheet.Protect Password:="FinDK"
End Sub
'Verpflegung mit Belegen
Private Sub ToggleButton3_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton3
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("N:N").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("N:N").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub
'Übernachtungen
Private Sub ToggleButton4_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton4
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("O:O").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("O:O").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub
'Einkauf Lebensmittel mit Beleg
Private Sub ToggleButton5_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton5
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("P:P").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("P:P").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub
'Einkauf Betriebsmaterial
Private Sub ToggleButton6_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton6
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("Q:Q").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("Q:Q").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub
'Weiterbildung
Private Sub ToggleButton7_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton7
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("R:R").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("R:R").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub
'Notizen
Private Sub ToggleButton8_Click()
ActiveSheet.Unprotect Password:="FinDK"
  ActiveCell.Activate
    With Worksheets("Lohnblatt").ToggleButton8
    .Caption = "" & IIf(.Value = True, "", "")
    .BackColor = IIf(.Value = False, &HFFFFFF, &HC0C0C0)
        If .Value = False Then
            Worksheets("Lohnblatt").Columns("T:T").EntireColumn.Hidden = False
              Else
            Worksheets("Lohnblatt").Columns("T:T").EntireColumn.Hidden = True
        End If
    End With
ActiveSheet.Protect Password:="FinDK"
End Sub

Ich danke vielmals für eure Bemühungen.

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Vor dem Drucken Spalten ausblenden	22.05.2014 15:24:10	Gast27757
Vor dem Drucken Spalten ausblenden	23.05.2014 15:15:34	Gast94722
Vor dem Drucken Spalten ausblenden	28.05.2014 14:55:01	Gast27757