Makro verdoppeln und Anpassen

Private Sub CheckBox63_Click() If CheckBox63.Value = False Then CheckBox64.Enabled = True CheckBox65.Enabled = True CheckBox66.Enabled = True End If If CheckBox63.Value = True Then CheckBox64.Enabled = False CheckBox65.Enabled = False CheckBox66.Enabled = False End If End Sub

Private Sub CheckBox64_Click() If CheckBox64.Value = False Then CheckBox63.Enabled = True CheckBox65.Enabled = True CheckBox66.Enabled = True End If If CheckBox64.Value = True Then CheckBox63.Enabled = False CheckBox65.Enabled = False CheckBox66.Enabled = False End If End Sub

Private Sub CheckBox65_Click() If CheckBox65.Value = False Then CheckBox64.Enabled = True CheckBox63.Enabled = True CheckBox66.Enabled = True End If If CheckBox65.Value = True Then CheckBox64.Enabled = False CheckBox63.Enabled = False CheckBox66.Enabled = False End If End Sub

Private Sub CheckBox66_Click() If CheckBox66.Value = False Then CheckBox64.Enabled = True CheckBox65.Enabled = True CheckBox63.Enabled = True End If If CheckBox66.Value = True Then CheckBox64.Enabled = False CheckBox65.Enabled = False CheckBox63.Enabled = False End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub verschränken(box As Long) Dim i As Long Dim start As Long Dim ende As Long Dim zustand As Boolean Application.ScreenUpdating = True start = Int((box - 63) / 4) * 4 + 63 ende = start + 3 zustand = ActiveSheet.Shapes("CheckBox" & box).OLEFormat.Object.Object.Value For i = start To ende If zustand = True Then If i box Then ActiveSheet.Shapes("CheckBox" & i).OLEFormat.Object.Object.Enabled = _ False Else If i box Then ActiveSheet.Shapes("CheckBox" & i).OLEFormat.Object.Object.Enabled = _ True End If Next i Application.ScreenUpdating = False End Sub

Hallo hier eine Datei mit Klassenprogrammierung: https://www.herber.de/bbs/user/113541.xlsm
Und hier nur Code:
In Klasse (in meinem Fall heißt sie "my_Checks")


Option Explicit
Public WithEvents clsCheckBox As MSForms.CheckBox
Private Sub clsCheckBox_Click()
Dim number As Long
Dim name As String
number = my_Number(clsCheckBox.name)
name = clsCheckBox.name
Call lock_my_Neighbours(name, number)
End Sub

In Modul:


Option Explicit
Public checkB() As New my_Checks
Function my_Number(ByVal meName As String) As Long
Dim i As Long
Dim clsNameLength As Long
clsNameLength = Len("CheckBox")
i = Len(meName)
my_Number = Right(meName, i - clsNameLength)
End Function
Sub my_Neighbours_are(ByVal meNumber As Long, _
ByRef arrNeighbours() As String)
Select Case meNumber
Case 1 To 62
ReDim arrNeighbours(1)
arrNeighbours(0) = meNumber + 1
arrNeighbours(1) = meNumber + 2
Case 63 To 186
ReDim arrNeighbours(3)
arrNeighbours(0) = meNumber + 1
arrNeighbours(1) = meNumber + 2
arrNeighbours(2) = meNumber + 3
arrNeighbours(3) = meNumber + 4
End Select
End Sub
Sub lock_my_Neighbours(ByVal meName As String, ByVal meNumber As Long)
Dim ws As Worksheet
Dim neighbourToLock() As String
Dim boolLocked As Boolean
Dim i As Long
Set ws = ActiveSheet
With ws
boolLocked = ws.Shapes(meName).OLEFormat.Object.Object.Value
Call my_Neighbours_are(meNumber, neighbourToLock)
Application.ScreenUpdating = False
If boolLocked Then
For i = LBound(neighbourToLock) To UBound(neighbourToLock)
ws.Shapes(neighbourToLock(i)).OLEFormat.Object.Object.Enabled = False
Next i
Else
For i = LBound(neighbourToLock) To UBound(neighbourToLock)
ws.Shapes(neighbourToLock(i)).OLEFormat.Object.Object.Enabled = True
Next i
End If
Application.ScreenUpdating = True
End With
End Sub
Sub check()
Dim i As Integer
Dim sh As OLEObject
For Each sh In ActiveSheet.OLEObjects
i = i + 1
ReDim Preserve checkB(i)
Set checkB(i).clsCheckBox = sh.Object
Next sh
End Sub

In DieseArbeitsmappe bzw. ThisWorkbook:


Private Sub Workbook_Open()
ThisWorkbook.Sheets(1).Select
Call check
End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro verdoppeln und Anpassen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread