VBA Codes inkorten

[wlsandman]

Goedenmiddag,

Hoe kan ik de volgende vba codes korter maken? (in werkelijkheid zijn het er veel meer...)

Private Sub CheckBox30_Change()
If CheckBox30.Value = True Then ActiveSheet.Range("bh39").Value = "01"
If CheckBox30.Value = False Then ActiveSheet.Range("bh39").Value = "00"
End Sub

Private Sub CheckBox31_Change()
If CheckBox31.Value = True Then ActiveSheet.Range("bh40").Value = "01"
If CheckBox31.Value = False Then ActiveSheet.Range("bh40").Value = "00"
End Sub

Private Sub CheckBox32_Change()
If CheckBox32.Value = True Then ActiveSheet.Range("bh41").Value = "01"
If CheckBox32.Value = False Then ActiveSheet.Range("bh41").Value = "00"
End Sub

Private Sub CheckBox33_Change()
If CheckBox33.Value = True Then ActiveSheet.Range("bh42").Value = "01"
If CheckBox33.Value = False Then ActiveSheet.Range("bh42").Value = "00"
End Sub

Private Sub CheckBox34_Change()
If CheckBox34.Value = True Then ActiveSheet.Range("bh43").Value = "01"
If CheckBox34.Value = False Then ActiveSheet.Range("bh43").Value = "00"
End Sub

Private Sub CheckBox35_Change()
If CheckBox35.Value = True Then ActiveSheet.Range("bh44").Value = "01"
If CheckBox35.Value = False Then ActiveSheet.Range("bh44").Value = "00"
End Sub

 

[Wigi]

Stel voor elke checkbox de LinkedCell in op de cel waar de output moet komen. In die laatste cel komt dan WAAR of ONWAAR te staan. In een andere maak je daar 0 of 1 van.

In VBA gaat dat ook, maar ik ken daar geen code voor. Ik weet wel dat ze heel moeilijk is. Google maar wat. Het zal met Class modules moeten.

Wigi

 

[Axel Hagg]

Dag WL,

Wat dacht je hier van?

Private Sub CheckBox39_Change()
vulrange 1
End Sub

Private Sub CheckBox40_Change()
vulrange 2
End Sub


private sub VulRange(a as integer)
Dim s as string
dim v as boolean

select case a
case 1
s=39
v=checkbox39.value
case 2
s=40
v=checkbox40.value
case 3
s=41
v=checkbox41.value
case 4
s=42
v=checkbox42.value
case 5
s=43
v=checkbox43.value
end select
ActiveSheet.Range("bh" & s).Value =iif(v,"01","00")
End sub

En als je de namen van de checkboxen korter maakt (C39, C40, C41) hoef je nog minder te typen.

Gegroet,

Axel.

 

[Roncancio]

Hallo,

Wellicht heb je hier iets aan.

Private Sub CommandButton1_Click()
For Each Control In Me.Controls
    If TypeName(Control) = "CheckBox" Then
        If Control.Value = True Then
            ActiveSheet.Range("BH" & Right(Control.Name, Len(Control.Name) - 8) + 9) = "01"
        Else
            ActiveSheet.Range("BH" & Right(Control.Name, Len(Control.Name) - 8) + 9) = "00"
        End If
    End If
Next
End Sub

Bovenstaande code bekijkt van alle besturingselementen op een formulier of het een CheckBox is.
Is dat het geval, dan wordt gekeken of de CheckBox waar is of niet.
Aan de hand hiervan worden de gegevens van in de BH-kolom ingevuld.

Met vriendelijke groet,


Roncancio

 

[Axel Hagg]

Dan RonCancio,

Ja, heel mooi en compact. Maar het kan nog compacter;

Private Sub CommandButton1_Click()
For Each Control In Me.Controls
If TypeName(Control) = "CheckBox" Then ActiveSheet.Range("BH" & Right(Control.Name, Len(Control.Name) - 8) + 9) = IIf(Control.Value, "01", "00")
Next
End Sub

Gegroet,

Axel.

 

[Roncancio]

Axel Hagg,

Ook heel mooi.:thumb:
Maar het kan nóg korter !

Private Sub CommandButton1_Click()
For Each Control In Me.Controls
If TypeName(Control) = "CheckBox" Then Range("BH" & Right(Control.Name, Len(Control.Name) - 8) + 9) = IIf(Control.Value, "01", "00")
Next
End Sub

(Dus zonder ActiveSheet)

Met vriendelijke groet,


Roncancio

 

[Axel Hagg]

Dag Roncancio,

Hier wreekt het zich dat ik niet gespecialiseerd ben in Excel. Maar er kan nog wat weg: "Me."

Gegroet,

Axel.

 

[Roncancio]

Hallo,

We kunnen de naam van de commandbutton aanpassen.
En de benaming voor de control aanpassen. (dus C ipv Control)

Private Sub Cmd1_Click()
For Each C In Controls
If TypeName(C) = "CheckBox" Then Range("BH" & Right(C.Name, Len(C.Name) - 8) + 9) = IIf(C.Value, "01", "00")
Next
End Sub

Met vriendelijke groet,


Roncancio

 

[Axel Hagg]

Dag Roncancio,

Ja, dit is het wel zo'n beetje,

gegroet,

Axel.

 

[Wigi]

Ik ben ook een voorstander van korte code, maar vergeet niet de variabelen te declareren.

 

[Axel Hagg]

Dag Wim,

Je hebt volkomen gelijk. Dus dit is de ultieme oplossing:

Private Sub Cmd1_Click()
Dim c

For Each C In Controls
If TypeName(C) = "CheckBox" Then Range("BH" & Right(C.Name, Len(C.Name) - 8) + 9) = IIf(C.Value, "01", "00")
Next
End Sub

Gegroet,

Axel.

 

[Wigi]

Beter nog,

Dim c As Control

 

[Axel Hagg]

Dag Wim,

Helemaal mee eens.

Gegroet,

Axel.

 

[Wigi]

Stel voor elke checkbox de LinkedCell in op de cel waar de output moet komen. In die laatste cel komt dan WAAR of ONWAAR te staan. In een andere maak je daar 0 of 1 van.

In VBA gaat dat ook, maar ik ken daar geen code voor. Ik weet wel dat ze heel moeilijk is. Google maar wat. Het zal met Class modules moeten.

Wigi

wlsandman

Zie hier. De code die hier nodig is kan voortkomen uit de code die ik in die andere topic ga proberen op te stellen.

 

[wlsandman]

Hartstikke bedankt allemaal :thumb:

Alleen ik krijg een gekke foutmelding:

Dim c As Control

For Each c In Controls

rest van de code

Bij de regel: For Each c in Controls geeft hij de foutmelding:

Object vereist.....

 

[Wigi]

Dim c As Control

For Each c In [B]Me.[/B]Controls

rest van de code

misschien?

 

[wlsandman]

Dan krijg ik een andere foutmelding:

Compileerfout
Kan de methode of het gegevenslid niet vinden.

 

[Wigi]

Doe maar een simpel voorbeeldbestandje.

 

[wlsandman]

Alstu

Eigenlijk zou het moeten zijn: Als ik de checkbox aanvink dan moet er in kolom BH een 1 komen staan (in diezelfde rij). De code hiervoor is niet zo moelijk, maar om hem voor tientallen checkboxen te herschrijven, daar heb ik eigenlijk geen tijd voor.

 

[Wigi]

Laat die code varen.

Met de Werkbalk Formulieren kan je ook een Selectievakje gebruiken. In de eigenschappen zet je de cel die gelinkt is met het selectievakje. Dat is dus een cel in de kolom BH. Doe dit eenmalig voor elk van de selectievakjes.