• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

code korter maken

Status
Niet open voor verdere reacties.
B

bjornesto

Gebruiker
Lid geworden
16 apr 2012
Berichten
201
ik heb volgende code die werkt

echter zou ik graag de code korter willen zodat het overzichtelijker wordt
is het mogelijk volgende stukken van code korter te maken?

dit stuk omdat ze 2x voorkomt
Code: 
   ActiveSheet.Shapes.Range(Array("Oval 21", "Oval 22", "Oval 23", "Oval 24", "Oval 25", "Oval 26", _
   "Oval 27", "Oval 28", "Oval 29", "Oval 30", "Oval 51", "Oval 52", "Oval 86")).Select

dit stuk korter maken als het kan
Code: 
    With Sheet1.CheckBox21
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox22
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox23
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox24
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox25
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox26
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox27
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox28
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox29
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox30
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox51
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox52
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox86
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With

Dit is de volledige code
Code: 
Private Sub ToggleButton7_Click()
macro_plan
'zie module naar macro_plan
On Error GoTo earlyexit
'zet deurnummer in het geel
If ToggleButton7.Value = True Then
   With ActiveSheet.Shapes.Range(Array("Oval 21", "Oval 22", "Oval 23", "Oval 24", "Oval 25", "Oval 26", _
   "Oval 27", "Oval 28", "Oval 29", "Oval 30", "Oval 51", "Oval 52", "Oval 86")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 244, 0)
        .Transparency = 0.5
        .Solid
    End With
    With Sheet1.CheckBox21
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox22
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox23
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox24
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox25
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox26
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox27
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox28
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox29
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox30
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox51
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
        With Sheet1.CheckBox52
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    With Sheet1.CheckBox86
    .Value = True
    .ForeColor = RGB(255, 0, 0)
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 8
    ActiveWindow.zoom = 75
    Range("A6").Activate
            End With
'zet deurnummer in het wit
    Else: ActiveSheet.Shapes.Range(Array("Oval 21", "Oval 22", "Oval 23", "Oval 24", "Oval 25", "Oval 26", _
   "Oval 27", "Oval 28", "Oval 29", "Oval 30", "Oval 51", "Oval 52", "Oval 86")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0.5
        .Solid
    End With
    With Sheet1.CheckBox21
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
    With Sheet1.CheckBox22
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox23
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
    With Sheet1.CheckBox24
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
    With Sheet1.CheckBox25
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
    With Sheet1.CheckBox26
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox27
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox28
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox29
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox30
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox51
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
        With Sheet1.CheckBox52
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
    With Sheet1.CheckBox86
    .Value = False
    .ForeColor = RGB(0, 0, 0)
    End With
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 8
    ActiveWindow.zoom = 75
    Range("A6").Activate
            End If
earlyexit:


End Sub
 
Als ze in een werkblad staan kan het bijvoorbeeld met.
Code: 
sq = array(21,22,23,24,25,26,27,28,29,30,51,52,86)

for i = 0 to ubound(sq) 
  with me.oleobjects("checkbox"& sq(i)).object
    .Value = True
    .ForeColor = RGB(255, 0, 0)
   End With
 next i
 
beste HSV

Ik krijg compile error als ik deze in een code zet in plaats van de checkboxen

Method or data member not found
 
Beste HSV

Heb het opgelost door de ME.oleobjects te veranderen in werkblad naam en dan lukt het wel

Hartelijk dank voor alles

Code: 
sq = Array(21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 51, 52, 86)
For I = 0 To UBound(sq)
  With Sheet1.OLEObjects("checkbox" & sq(I)).Object
    .Value = True
    .ForeColor = RGB(255, 0, 0)
   End With
 Next I
 
Graag gedaan,

Excuses; uiteraard werk 'Me' alleen vanuit een werkbladmodule.
Maar vanuit de losse pols in het reageervenster geschreven ben ik tevreden. :)
 
Waarom zou je überhaupt de 'forecolour' van een vinkvak wijzigen ?
Als je de vinkvakken 51, 52 en 86 hernoemt tot 31, 32 en 33:

Code: 
For j = 21 To 33
  With Sheet1.OLEObjects("checkbox" & j).Object
    .Value = True
    .ForeColor = RGB(255, 0, 0)
   End With
 Next
 
snb

De reden hiervoor is dat ik in excel een plan heb gemaakt met shapes (voorbeeld een deurnummer heeft sleutel 15 nodig)
Die ik gelinkt heb aan een userform.

Dus als je op een voorgeprogrammeerde togglebutton klikt
kan het zijn dat hij meer dan 1 shape in het geel zet (of andere kleur kan zijn dat meerdere deurnummers sleutel 15 nodig hebben)
klik je terug op die togglebutton dan gaat hij terug naar zijn originele staat.

Deze laten mij zien op een plan waar ze die sleutel nodig hebben hebben en waar niet

Verder heb ik dan de checkboxen op een leeg gedeelte van het plan gezet met hun naam die aanduiden welke deur(en) die in het geel staan.
Zo moeten ze niet altijd over en weer kijken in de userform en op het plan

Dus klik je in de userform op een knop gaat hij op het plan de shape in het geel zetten alsook de benaming van de deur in de checkbox

Zo is het document dynamisch en gemakkelijk
 
Kun je dit stuk ook korter maken ?

Heb het al geprobeerd met de code die je mij gegeven hebt maar ze werkt niet op dit onderste gedeelte.

Code: 
With ActiveSheet.Shapes.Range(Array("Oval 21", "Oval 22", "Oval 23", "Oval 24", "Oval 25", "Oval 26", _
   "Oval 27", "Oval 28", "Oval 29", "Oval 30", "Oval 51", "Oval 52", "Oval 86")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 244, 0)
        .Transparency = 0.5
        .Solid
    End With
 
Niet korter, maar zo worden ze niet meer geselecteerd.

Code: 
Dim sq, i As Long
sq = Array("Oval 21", "Oval 22", "Oval 23", "Oval 24", "Oval 25", "Oval 26", _
   "Oval 27", "Oval 28", "Oval 29", "Oval 30", "Oval 51", "Oval 52", "Oval 86")
For i = 0 To UBound(sq)
  With Me.Shapes(sq(i)).Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 244, 0)
        .Transparency = 0.5
        .Solid
    End With
Next i
 
Laatst bewerkt:
De bedoeling is eigelijk dat hij de array van sq gebruikt voor zowel checkboxen als ovals.
Heb die zo gezet in de code dat checkbox 21 en shape ("Oval 21") in dezelfde code vallen. (kunnen er ook meerdere zijn natuurlijk)

Is dit mogelijk of moet je dan 2 arrays maken


Code: 
 sq = Array(21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 51, 52, 86)
zou de array voor zowel checkbox als oval kunnen zijn.

Zo moet ik maar 1 keer een array aanpassen

als het niet gaat is het ook goed hoor :-)
 
Code: 
For j = 21 To 33
  With Sheet1.OLEObjects("checkbox" & j).Object
    .Value = True
    .ForeColor = RGB(255, 0, 0)
   End With
  With Sheet1.shapes("oval" & j).fill
        .ForeColor.RGB = RGB(255, 244, 0)
        .Transparency = 0.5
        .Solid
   End With
 Next
 
snb u code werkt

echter zijn niet alle checkboxen en ovals opeenvolgend. zie code hieronder
Code: 
sq = Array(21, 22, 23, 24, 25, 26, 27, 28, 29, 30, [COLOR="#FF0000"]51, 52, 86[/COLOR])

HSV heeft dit opgelost met die array via ubound maar vroeg mij af of die sq ook te gebruiken is voor de shape ovals.

Zo komt mijn code een stuk korter hieronder is een voorbeeld van een togglebutton

Code: 
Private Sub ToggleButton59_Click()
sq = Array(3, 4, 5, 6, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 31, 32, 33, 36, 46, 47)

macro_plan

On Error GoTo earlyexit
'zet deurnummer in het geel
If ToggleButton152.Value = True Then        'pas nummer van togglebutton aan

   With ActiveSheet.Shapes.Range(Array("Oval 3", "Oval 4", "Oval 5", "Oval 6", _
   "Oval 10", "Oval 11", "Oval 12", "Oval 13", "Oval 14", "Oval 15", "Oval 16", _
   "Oval 17", "Oval 18", "Oval 19", "Oval 20", _
   "Oval 31", "Oval 32", "Oval 33", "Oval 36", _
   "Oval 46", "Oval 47")).Select
   
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 244, 0)
        .Transparency = 0.5
        .Solid
    End With
    
   'selecteert de checkboxen en zet ze in het rood
   'zie boven naar sq voor de checkbox nummer aan te passen indien nodig
   For i = 0 To UBound(sq)
   With Sheet1.OLEObjects("checkbox" & sq(i)).Object
    .Value = True
    .ForeColor = RGB(255, 0, 0)
   End With
   Next i
   
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 8
    ActiveWindow.zoom = 75
    Range("A6").Activate
            End With
'zet deurnummer in het wit
    Else: ActiveSheet.Shapes.Range(Array("Oval 3", "Oval 4", "Oval 5", "Oval 6", _
    "Oval 10", "Oval 11", "Oval 12", "Oval 13", "Oval 14", "Oval 15", "Oval 16", _
    "Oval 17", "Oval 18", "Oval 19", "Oval 20", _
    "Oval 31", "Oval 32", "Oval 33", "Oval 36", _
    "Oval 46", "Oval 47")).Select
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0.5
        .Solid
    End With
    
    'selecteert de checkboxen en zet ze in het zwart
    'zie boven naar sq voor de checkbox nummer aan te passen indien nodig
   For i = 0 To UBound(sq)
   With Sheet1.OLEObjects("checkbox" & sq(i)).Object
    .Value = False
    .ForeColor = RGB(0, 0, 0)
   End With
   Next i
   
    Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 8
    ActiveWindow.zoom = 75
    Range("A6").Activate
            End If
earlyexit:

End Sub
 
Het lijkt me nu toch niet zo moeilijk om van de gegeven codes nu zelf eentje in elkaar te zetten.
 
daarom had ik al eerder gesuggereerd:

Als je de vinkvakken 51, 52 en 86 hernoemt tot 31, 32 en 33:


Structuring precedes coding !
 
snb

Je hebt gelijk kan dat ook zoals in u suggestie aanpassen :-)

Dank u daarvoor
 
HSV

Heb het verder uitgezocht.

Inderdaad de code was gemakkelijk voor nadien te maken

dit is ze geworden

Code: 
Private Sub ToggleButton20_Click()
sq = Array(82)

macro_plan

On Error GoTo earlyexit
'zet deurnummer in het geel
If ToggleButton20.Value = True Then        'pas nummer van togglebutton aan
   For i = 0 To UBound(sq)
   With Sheet1.Shapes("Oval " & sq(i)).Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 244, 0)
        .Transparency = 0.5
        .Solid
   End With
   Next i
   'selecteert de checkboxen en zet ze in het rood
   'zie boven naar sq voor de checkbox nummer aan te passen indien nodig
   For i = 0 To UBound(sq)
   With Sheet1.OLEObjects("checkbox" & sq(i)).Object
    .Value = True
    .ForeColor = RGB(255, 0, 0)
   End With
   Next i
   
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 8
    ActiveWindow.zoom = 75
    Range("A6").Activate
'zet deurnummer in het wit
    Else:   For i = 0 To UBound(sq)
    With Sheet1.Shapes("Oval " & sq(i)).Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0.5
        .Solid
   End With
   Next i
   'selecteert de checkboxen en zet ze in het rood
   'zie boven naar sq voor de checkbox nummer aan te passen indien nodig
   For i = 0 To UBound(sq)
   With Sheet1.OLEObjects("checkbox" & sq(i)).Object
    .Value = False
    .ForeColor = RGB(0, 0, 0)
   End With
   Next i
   
   Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
    Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 8
    ActiveWindow.zoom = 75
    Range("A6").Activate
            End If
earlyexit:

End Sub

Snb u code was ook goed maar had die sq nodig aangezien ik niet bij elke knop aansluitende checkboxen of oval kon programmeren.
Aangezien ik dan ook geen class module kon gebruiken moest ik de methode van HSV toepassen

daarom heb ik HSV zijn code verder gebruikt omdat die dat wel kan

sorry daarvoor maar u code werkt wel perfect :-)

dank u nogmaals allebei
 
bjornesto zei:
Snb u code was ook goed maar had die sq nodig aangezien ik niet bij elke knop aansluitende checkboxen of oval kon programmeren.
Aangezien ik dan ook geen class module kon gebruiken moest ik de methode van HSV toepassen
Klik om te vergroten...

Geen van beide beweringen lijkt mij correct.
 
dit is een deel van de code die in een met verschillende sq die verwijzen naar oval en checkboxen in dezelfde file die in dezelfde userform staan.

Deel van alle ovals en checkboxen dat ik voor deze code nodig heb --> voorbeeld (dit zijn alle deuren die sleutel 15 nodig hebben --> zowel oval als checkboxen)
Code: 
Private Sub ToggleButton22_Click()
sq = Array(3, 5, 6, 11, 12, 13, 14, 15, 16, 17, 18, 19, 31, 32, 33, 36, 46, 47)


Dit is voor alle oval en checkboxen die er op het werkblad staan --> voorbeeld (dit is een loper die alle deuren open krijgt)
Code: 
Private Sub ToggleButton27_Click()
sq = Array(3, 4, 5, 6, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 31, 32, 33, 36, 46, 47)

Als ik u code gebruik en ze verander die sq in die van u gaat hij die toch selecteren of niet van I = 21 to 33

Terwijl ik bij sommige maar een deel van de ovals en checkboxen moet hebben.

Kan ik daarvoor dan een class module gebruiken? Ik vraag dit uit informatie aangezien jij er veel meer van kan dan ik
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan