title image


Smiley Re: Fragen zu Kontrollkästchen Formular WAHR/FALSCH
Hallo,



hab das mal etwas erweitert, damit du das besser nachvollziehen und ggf. ändern kannst.



Option Explicit

Sub KKästchen()

Const SPALTE As Integer = 10 'Die gewünschte Spalte

Const AB_ZEILE As Long = 7 'Ab welcher Zeile

Const WIEVIEL_ZEILEN As Long = 10 'Wieviel Zeilen, sprich Kontrollkästchen

Const HOEHE As Single = 18 'Höhe der Zeilen/Kontrollkästchen

Const BREITE As Single = 72 'Breite der Kontrollkästchen

Dim KK As Object, Z As Long, rc As Long

Dim Links As Single, Oben As Single

Links = Cells(AB_ZEILE, SPALTE).Left

Oben = Cells(AB_ZEILE, SPALTE).Top

Application.ScreenUpdating = False

Range(Cells(AB_ZEILE, SPALTE), Cells(AB_ZEILE + WIEVIEL_ZEILEN, SPALTE)) _

.RowHeight = HOEHE

For Z = 1 + AB_ZEILE - 1 To AB_ZEILE + WIEVIEL_ZEILEN - 1 'wieviele Kontrollkästchen

Set KK = ActiveSheet.CheckBoxes.Add(Links, Oben, BREITE, HOEHE)

With KK

.Name = "Kok" & Z

'Wenn Beschriftung gewünscht ist

.Characters.Text = "" '"Deine Beschriftung" & Z

.Enabled = True

.LockedText = False

.OnAction = ""

.Placement = 3

.PrintObject = True

.Value = 1

.LinkedCell = .TopLeftCell.Address

.Display3DShading = True

End With

Oben = Oben + HOEHE

Next

Set KK = Nothing

Application.ScreenUpdating = True

End Sub

Sub Alle_ein_aus()

Dim sh As Shape

For Each sh In ActiveSheet.Shapes

If sh.Type = 8 Then

If sh.FormControlType = 1 Then

If sh.ControlFormat.Value = 1 Then

sh.ControlFormat.Value = 0

Else

sh.ControlFormat.Value = 1

End If

End If

End If

Next

End Sub

Sub Alle_loeschen()

Dim sh As Shape

For Each sh In ActiveSheet.Shapes

If sh.Type = 8 Then

If sh.FormControlType = 1 Then

sh.Delete

End If

End If

Next

End Sub



Gruß M.I.Nitraum



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: