nur bestimmte Spalten anzeigen per Makro

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Matthias,
wenn du vorher Spalten einfügst, dann sind mehrere Anpassungen im Code notwendig.
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private Sub CommandButton1_Click()
Dim oCntrl As MSForms.Control
Dim intC As Integer

On Error Resume Next
Application.ScreenUpdating = False

For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        intC = Cint(Mid(oCntrl.Name, 3))
        Sheets("Gesamtliste").Columns(intC).Hidden = Not oCntrl.Value
        Sheets("Gesamtliste").Columns(intC + 1).Hidden = Not oCntrl.Value
        Sheets("Gesamtliste").Columns(54 + Int((intC - 1) / 2)).Hidden = Not oCntrl.Value
    End If
Next
ActiveWindow.ScrollColumn = 3
Application.ScreenUpdating = True
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Dim oCntrl As MSForms.Control
For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        oCntrl.Value = True
    End If
Next
End Sub

Private Sub CommandButton4_Click()
Dim oCntrl As MSForms.Control
For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        oCntrl.Value = False
    End If
Next
End Sub

Private Sub CommandButton5_Click()
Dim oCntrl As MSForms.Control
For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        oCntrl.Value = Not oCntrl.Value
    End If
Next
End Sub
Private Sub UserForm_Activate()
Dim oCB As MSForms.CheckBox
Dim rng As Range
Dim intT As Integer, intL As Integer

intL = 18

For Each rng In Sheets("Gesamtliste").Range("F3:BA3") ' hier den Bereich mit den Baugrößen festlegen!!!
    If rng.Column Mod 2 = 0 Then
        Set oCB = Me.Controls.Add("Forms.CheckBox.1")

        intT = intT + 20

        If intT > 160 Then
            intT = 20
            intL = intL + 80
        End If

        With oCB
            .Caption = rng.Text
            .Top = intT
            .Left = intL
            .Height = 18
            .Width = 60
            .Value = Not rng.EntireColumn.Hidden
            .Name = "CB" & rng.Column
        End With
    End If
Next

End Sub

Gruß Sepp

Hallo Matthias,
sicher geht das, aber ob es einfacher ist weis ich nicht. Für mich ist es nicht schwer, aber wenn du die Tabelle weiter veränderst, dann könnte das ganze wieder nicht funktionieren.
Das Einzige was du nun anpassen musst ist die Konstante "strRange", sie gibt den Bereich mit den Baugrössen an.
Kopiere diesen Code komplett in das Modul des UF.
' **********************************************************************
' Modul: UserForm1 Typ: Userform
' **********************************************************************

Option Explicit

Private Const strRange As String = "F3:BA3" 'Bereich mit den Baugrössen

Private Sub CommandButton1_Click()
Dim oCntrl As MSForms.Control
Dim rng As Range
Dim intC As Integer

On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Gesamtliste")
    .Range(.Cells(1, .Range(strRange).Columns(1).Column + .Range(strRange).Columns.Count), _
        .Cells(1, .Cells(.Range(strRange).Row, Columns.Count).End(xlToLeft).Column)) _
        .EntireColumn.Hidden = True

    For Each oCntrl In Me.Controls
        If TypeOf oCntrl Is MSForms.CheckBox Then
            intC = Cint(Mid(oCntrl.Name, 3))
            .Columns(intC).Hidden = Not oCntrl.Value
            .Columns(intC + 1).Hidden = Not oCntrl.Value

            If oCntrl.Value Then
                'Gewichtsspalten suchen
                Set rng = .Rows(.Range(strRange).Row).Find(what:=oCntrl.Caption & "G", LookAt:=xlWhole)

                If Not rng Is Nothing Then rng.EntireColumn.Hidden = False
            End If
        End If
    Next

End With
ActiveWindow.ScrollColumn = 3
Application.ScreenUpdating = True
Set rng = Nothing
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Dim oCntrl As MSForms.Control
For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        oCntrl.Value = True
    End If
Next
End Sub

Private Sub CommandButton4_Click()
Dim oCntrl As MSForms.Control
For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        oCntrl.Value = False
    End If
Next
End Sub

Private Sub CommandButton5_Click()
Dim oCntrl As MSForms.Control
For Each oCntrl In Me.Controls
    If TypeOf oCntrl Is MSForms.CheckBox Then
        oCntrl.Value = Not oCntrl.Value
    End If
Next
End Sub
Private Sub UserForm_Activate()
Dim oCB As MSForms.CheckBox
Dim rng As Range
Dim intT As Integer, intL As Integer

intL = 18

For Each rng In Sheets("Gesamtliste").Range(strRange)
    If rng.Column Mod 2 = 0 Then
        Set oCB = Me.Controls.Add("Forms.CheckBox.1")

        intT = intT + 20

        If intT > 160 Then
            intT = 20
            intL = intL + 80
        End If

        With oCB
            .Caption = rng.Text
            .Top = intT
            .Left = intL
            .Height = 18
            .Width = 60
            .Value = Not rng.EntireColumn.Hidden
            .Name = "CB" & rng.Column
        End With
    End If
Next

Me.Width = intL + 85
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

nur bestimmte Spalten anzeigen per Makro

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

327 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nur bestimmte Spalten anzeigen per Makro

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

327 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread