• 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.

Celeigenschappen aanpassen van één type kleur cellen + beveiligen.

Status
Niet open voor verdere reacties.

Pieter671

Gebruiker
Lid geworden
26 jun 2015
Berichten
100
Beste Excel-kenner,

Met regelmaat bescherm ik spreadsheets met meerdere tabbladen en meerdere invulvelden op deze tabbladen.

Het is als altijd een behoorlijke kluif om van de invulvelden de cel-eigenschappen aan te passen en vervolgens de tabbladen te beveiligen.

Alle cellen krijgen de cel-eigenschappen: Bescherming "Geblokkeerd" en "Verborgen".
En bij alle 'gele' invulvelden moet de vinkjes weer uit, zodat ze na het beveiligen van de tabbladen in te vullen zijn.

Ik heb een opzetje gemaakt om dit met een macro's te automatiseren.

De eerste macro "Beveiligen" doet het alleen op eerste tabblad en niet op de overige tabbladen.

Code:
Sub Beveiligen()

    Dim wSheetName As Worksheet
    
    For Each wSheetName In Worksheets
  
        'tijdelijk voor herhaald testen van macro
        wSheetName.Unprotect Password:="ww"
            
        Cells.Select
        Selection.Locked = True
        Selection.FormulaHidden = True
              
        'Call Kleurenselectie
              
        wSheetName.Protect Password:="ww", UserInterFaceOnly:=True
    
    Next wSheetName

End Sub

De tweede macro doet het op een individueel tabblad goed, maar zodra ik 'm integreer in de eerste macro gaat het fout.

Het kiezen van de kleur hoeft maar één keer.
Het bereik van de cellen hoeft wat mij betreft niet iedere keer gekozen te worden. Ieder tabblad alleen het actieve gebied.

Code:
Sub Kleurselectie()
    
    Dim kleur As Range
    Dim totaalbereik As Range
    Dim cel As Range

    Set kleur = Application.InputBox("Selecteer een cel met de te selecteren kleur", "Kleurselectie", , , , , , 8)
    Set totaalbereik = Application.InputBox("Selecteer het te selecteren vlak", "Kleurselectie", , , , , , 8)

    'Application.ScreenUpdating = False

    For Each cel In totaalbereik
        
        If cel.Interior.ColorIndex = kleur.Interior.ColorIndex Then
        
            cel.Select
            Selection.Locked = False
            Selection.FormulaHidden = False
            
        End If
    
    Next cel

    'Application.ScreenUpdating = True

End Sub


Vraag:

Weet iemand deze twee maco's samen te voegen en werkend te krijgen?
Ik wil de macro graag starten vanuit "PERSONAL.XLSB"
 

Bijlagen

  • Test - beveiliging velden.xlsm
    25,5 KB · Weergaven: 16
Pieter,

Om ze samen te voegen.
In je eerste macro staat: 'Call Kleurenselectie

maak hiervan
Code:
Call Kleurselectie

dus zonder ' en met de juiste naam van je procedure (kleur ipv kleuren)
 
De macro naam achter Call in de eerste macro komt niet overeen met de naam van je tweede macro (even los van dat je hem nu als comment hebt gemarkeerd)

Als je Call kleurenselectie aanpast naar Call Kleurselectie

loopt ie er bij mij probleemloos doorheen..

Edit: slome sjakie deed ff wat tussendoor en toen had lam201 intussen een zelfde antwoord geplaatst
 
Bedankt voor jullie reactie.

Het '-teken had ik bewust geplaatst om de twee delen apart te testen.
Later de Call met verkeerde verwijzing toegevoegd, was een type foutje.

Feit blijft dat bij mij de
Code:
 For Each wSheetName In Worksheets
niet goed werkt. (Excel 2013)

Ben wel benieuwd hoe het kan dat deze code niet werkt?
Ligt dit aan Excel2013?
Heeft iemand een idee?


Inmiddels op het internet een andere opzet van de VBA-code gevonden.
Een For Next met het tellen van het aantal tabbladen.

Deze werkt perfect en doet wat ik wil.

Code:
Sub Beveiligen()

    Dim aantal_tabbladen As Integer
    Dim i As Integer
    Dim kleur As Range
    Dim totaalbereik As Range
    Dim cel As Range
    
    aantal_tabbladen = ActiveWorkbook.Worksheets.Count
    
    Set kleur = Application.InputBox("Selecteer een cel met de te selecteren kleur", "Kleurselectie", , , , , , 8)
        
    For i = 1 To aantal_tabbladen
            
        Sheets(i).Select
        
        Cells.Select
        Selection.Locked = True
        Selection.FormulaHidden = True
              
        Set totaalbereik = Application.InputBox("Selecteer het te selecteren vlak", "Kleurselectie", , , , , , 8)
        
        For Each cel In totaalbereik
        
            If cel.Interior.ColorIndex = kleur.Interior.ColorIndex Then
        
                cel.Select
                Selection.Locked = False
                Selection.FormulaHidden = False
            
            End If
    
        Next cel
                       
        Sheets(i).Protect Password:="ww", UserInterFaceOnly:=True
    
    Next i
    
    Sheets(1).Select

End Sub
 
Laatst bewerkt:
de beveiliging in jou code werkt niet omdat deze alleen toegepast wordt op het actieve werkblad.

vervang je code door deze:

Code:
Sub Beveiligen2()
Dim wSheetName As Worksheet
    
For Each wSheetName In Worksheets
        
    'tijdelijk voor herhaald testen van macro
    wSheetName.Unprotect Password:="ww"
    
    With wSheetName.Range("A1:H50")
        .Locked = True
        .FormulaHidden = True
    End With
    
    'Call Kleurenselectie
    wSheetName.Protect Password:="ww", UserInterFaceOnly:=True

Next wSheetName

End Sub
 
Je hebt geen hele nieuwe code nodig.. en nee het ligt niet aan Excel 2013 maar gewoon (zoals meestal) aan de vaardigheden van de programmeur.. ;)

In jou code zit een van de weinige gevallen dat een select (of activate) van een werkblad niet overbodig is if zelfs noodzakelijk is. Omdat jij inputboxen hebt in de kleurselectie code moet je zorgen dat het werkblad dat behandeld wordt ook getoond wordt dat gebeurde in jou oude code niet. de code beveiligen ging wel "onder water" naar blad 2 maar jou scherm bleef op blad 1 staan en toonde dan opnieuw de input boxen..

met toevoeging van 1 regel code met wSheetName.Select ben je er ook wordt de wel overgeschakeld naar de te bewerken sheet:

Code:
Sub Beveiligen()

    Dim wSheetName As Worksheet
    
    For Each wSheetName In Worksheets
        'tijdelijk voor herhaald testen van macro
        wSheetName.Unprotect Password:="ww"
            
        wSheetName.Select
        Cells.Select
        Selection.Locked = True
        Selection.FormulaHidden = True
              
        Call Kleurselectie
              
        wSheetName.Protect Password:="ww", UserInterFaceOnly:=True
    
    Next wSheetName

End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan