wachtwoordexcelblad opheffen en weer activeren

[FrankRiensema]

Voor onze Mahjongvereniging heb ik een Excel gemaakt waarin wij de score van de speelavond bij kunnen houden.
Nu heb ik een macro gemaakt waarmee de eindstand van de avond gekopieerd wordt naar een ander werkblad waar de competitiestand van het jaar wordt bijgehouden. Als ik de het werkblad beveilig dan werkt de macro niet meer. Weet iemand waar ik de code moet zetten om het wachtwoord eraf te halen en als de gegevens gekopieerd zijn er weer op te zetten?

Onderstaand heb ik geprobeerd om in ThisWorkbook te zetten maar dat werkt niet

Sub UserInterface(Sh As Object)

If Sh.ProtectContents = True Then

Sh.Protect Password:="test", UserInterfaceOnly:=True

End If

End Sub



Private Sub Workbook_Open()

UserInterface Sheets("Blad1")

End Sub

Zelf heb ik geen verstand van deze materie, maar al doende leert men!

Groet,
Frank

 

[Leotaxi]

deze zou dat moeten doen

With Sheets("naam van sheet")
    .Unprotect Password:="gekozen wachtwoord"
    'huidige code om score weg te schrijven
    .Protect
End With

mvg
Leo

 

[FrankRiensema]

deze zou dat moeten doen

With Sheets("naam van sheet")
    .Unprotect Password:="gekozen wachtwoord"
    'huidige code om score weg te schrijven
    .Protect
End With

mvg
Leo

 

[FrankRiensema]

Hoi Leo,

Bedankt voor je reactie.
Ik weet niet precies waar ik de code moet invoegen en heb het op 2 verschillende plaatsen geprobeerd maar krijg de volgende fout:
Compileerfout Sub of Function is niet gedefinieerd.

Sub eindstandnaarcompetitie()
'
' eindstandnaarcompetitie Macro
'
' Sneltoets: Ctrl+k
'
Application.ScreenUpdating = False
With Sheets("competitie")
Unprotect Password:="test"
Range("A3:E3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("competitie").Select
ActiveWindow.SmallScroll ToRight:=16
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 20
Range("AB3").Select
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 19
ActiveWindow.ScrollColumn = 18
ActiveWindow.ScrollColumn = 17
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A1").Select
Application.ScreenUpdating = True
Protect
End With
End Sub

Groet,
Frank

 

[Leotaxi]

Dag Frank,

plaats dat bestand eens want in deze code kan veel weggelaten worden
zonder voorbeeld is mij niet helemaal duidelijk naar waar de score wordt weggeschreven.


mvg
Leo

 

[FrankRiensema]

Hoi Leo,

Bijgaan het bestand.
De tabbladen "eindstand" en "competitie" zijn beveiligd met "test"

Groet,
Frank

 

[Leotaxi]

wegens tijdgebrek enkel de beveiliging gedaan, later een verkorte versie


mvg
Leo

 

[FrankRiensema]

Hoi Leo,

Geweldig het werkt, ontzettend bedankt.
De macro is opgenomen met de functionaliteit die in excel zit dus waarschijnlijk kan het wel wat korter

Groet,
Frank

 

[Leotaxi]

Hoi Frank,

zoals beloofd versie met ingekorte code
wil je wel de vraag als opgelost zetten ?


mvg
Leo

 

[FrankRiensema]

Hoi Leo,

Nogmaals heel erg bedankt voor je hulp, het werkt uitstekend.
Zoals gezegd had ik de macro gemaakt met de functionaliteit van Excel, "macro opnemen".
Maar de code zoals jij hem hebt gemaakt is inderdaad een stuk korter.
Ik ga mij erin verdiepen, want het is wel erg makkelijk als je dit kan.

Nog een vraagje, in jouw code staat ook de volgende regel:

Application.CutCopyMode = False

Waarom is het nodig om die toe te voegen?

Groet,
Frank

 

[VenA]

Application.CutCopyMode = False

Waarom is het nodig om die toe te voegen?

Deze is niet nodig. Alleen als er gewerkt wordt met .Select en copy.

Volgens mij kan je de hele code reduceren tot

Sub wissen()
'
' wissen Macro
' Wist alle gegevens van de speelrondes
'
' Sneltoets: Ctrl+w
'
Application.ScreenUpdating = False
For Each Sh In Sheets
    With Sh
        On Error Resume Next
        If Left(.Name, 5) = "ronde" Then
            .Unprotect "2110hf"
            .UsedRange.SpecialCells(2, 1).ClearContents
            .Protect "2110hf"
         End If
    End With
Next Sh
Sheets("inschrijvingen").Range("G3:G42").ClearContents
End Sub

Sub eindstandnaarcompetitie()
'
' eindstandnaarcompetitie Macro
'
' Sneltoets: Ctrl+k
'
Application.ScreenUpdating = False
Sheets("eindstand").Unprotect "test"
With Sheets("competitie")
    .Unprotect "test"
    Sheets("eindstand").Range("A3", "E43").Copy
        .Cells(.Cells(.Rows.Count, 28).End(xlUp).Row, 28).Offset(1).PasteSpecial Paste:=xlFormats
        .Cells(.Cells(.Rows.Count, 28).End(xlUp).Row, 28).Offset(1).PasteSpecial Paste:=xlValues
    .Protect "test"
End With
Sheets("eindstand").Protect "test"
End Sub

Zet het bij voorkeur in één module ipv een stuk of zeven. Haal ook alle onnodige code eruit. Het formulier doet niets net als de code onder de bladen.

 

[FrankRiensema]

Hoi VenA,

Bedankt voor je reactie. Ik merk dat dit wel wat anders is dan een macro met de Excel-functionaliteit maken.
Ik ga ermee aan de slag. Ik zie wel dat ik nog een hoop kan leren.

Groet,
Frank