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

Ansicht des Beitrags:
Von:
Gast27757		 Datum:
22.05.2014 15:24:10		 Views:
1704		 Rating:
     
Antwort:
  Ja
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.

 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
'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.

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
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:
WYSIWYG-Editor, ctl00_Content_editor1



  • 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
Rot Vor dem Drucken Spalten ausblenden
 22.05.2014 15:24:10 Gast27757
NotSolved
23.05.2014 15:15:34 Gast94722
NotSolved
28.05.2014 14:55:01 Gast27757
NotSolved