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

Macro's uitvoeren op beveiligde sheets

Status
Niet open voor verdere reacties.
B

Bjorkie

Gebruiker
Lid geworden
12 sep 2017
Berichten
147
Ik heb een probleem, na het invoeren van een beveiliging.
In bijlage mijn document. alle sheets zijn beveilgd met 'test'
Als ik een macro oproep, dan neem ik eerst de beveiliging weg, van alle sheets waar deze Macro gegevens moet gaan halen.
op het einde activeer ik de beveiliging opnieuw.
Code voorbeeld:
Code: 
Option Explicit
Private Const PW = "test"
Sub Create_Camlist()
' Empty_CamList Macro
' Clear all data in CamList page.
    Worksheets("Calculation").Unprotect Password:=PW
    Worksheets("Camera List").Unprotect Password:=PW

    Application.ScreenUpdating = False
    Worksheets("Camera List").Range("C5:E240").Select
    Selection.ClearContents
' expand the cameras from Calculation page into the list on sheet Camera List.
    Dim c As Range, i As Variant
    rij = 5
    For Each c In Sheets("Calculation").Range("B5:B240")
        If c <> "" And c.Offset(, 2) <> "Quant." Then
           For i = 1 To c.Offset(, 2)
               If Left(c, 11) <> "Camera name" Then
                  If c.Offset(, 1) = "" And IsNumeric(c.Offset(, 2)) Then Exit Sub
                    With Sheets("Camera List")
                        .Cells(rij, 3) = c
                        .Cells(rij, 5) = c.Offset(, 17)
                        .Cells(rij, 4) = c.Offset(, 1)
                  End With
                End If
rij = rij + 1
            Next
        End If
    Next
'
' Create_Summary_List_Cameras Macro
'generate short list on sheet 'Camera List'
     Worksheets("Camera List").Range("AS5:AS30").ClearContents
     Range("D5:D240").Copy Range("AS5")
     Range("AS5:AS30").RemoveDuplicates 1, xlNo
'
Application.ScreenUpdating = True
' select Cel A1 with cursor
    Range("A1").Select
    Worksheets("Calculation").Protect Password:=PW
    Worksheets("Camera list").Protect Password:=PW

End Sub
nu werkt deze Macro niet meer, en krijg ik steeds de foutmelding op 'Rij = 5' "Compile error: Variable not defined.
kan mij iemand uitleggen wat ik verkeerd doe?
eventueel een tip voor het beveiligen van mijn bestand?
bedoeling is, dat slechts enekel velden toegankelijk zijn. al diegene met formules zijn 'locked cells', dus niet toegankelijk.

(bestand ook in bijlage.)Bekijk bijlage camera oefening v15-Security.xlsm
 
Bij option explicit moet je alle variabelen declareren.

Dus voeg eens : Dim Rij as Integer toe aan je code
 
Hey SjonR: bedankt voor deze tip.
werkt perfect (voor deze macro tenminste)
Op de sheet 'equipment list' heb ik ook een script staan , nu heb ik daar een ook foutmelding.
1MaxRows = Variable not found?
Code: 
Option Explicit
Private Const PW = "test"

Sub Generate_EquipmList()
Application.ScreenUpdating = False
Sheets("Camera List").Unprotect Password:=PW
Sheets("Equipment list").Unprotect Password:=PW
'Camera List Page
'Copy short Camera List to Equipment page where quantity is equal or higher then 0
    Worksheets("Camera List").Range("$AS$5:$AT$30").AutoFilter
    Worksheets("Camera List").Range("$AS$5:$AT$30").AutoFilter Field:=2, Criteria1:=">0", _
    Operator:=xlAnd
    Worksheets("Camera List").Range("AS5:AU30").Copy
    'Start at first empty line on Equipment page and copy camera list
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Application.CutCopyMode = False
    Worksheets("Camera List").Range("$AS$5:$AT$30").AutoFilter
'*******************************************************************************************
'Recorder Page
'Create Hardware list and copy item to Equipment list, to last empty line
    'Make filter on Hardware and select all where quant is >=0
    Worksheets("Recorders").Unprotect Password:=PW
    Worksheets("Recorders").Range("A20:K20").AutoFilter
    Worksheets("Recorders").Range("$A$20:$K$27").AutoFilter Field:=11, Criteria1:=">0", _
        Operator:=xlAnd
    'Copy filtered data from colum A to first empty line in Equipment list sheet
    Worksheets("Recorders").Range("A21:A27").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
    'Copy filtered data from colum B to first empty line in Equipment list sheet
    Worksheets("Recorders").Unprotect Password:=PW
    Worksheets("Recorders").Range("B21:B27").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    Range("C" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
    'Copy filtered data from colum K to first empty line in Equipment list sheet
    Worksheets("Recorders").Unprotect Password:=PW
    Worksheets("Recorders").Range("K21:K27").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
    Range("B" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
'*******************************************************************************************
    'Copy HDD type & Camconnect to Equipment list
    Worksheets("Recorders").Unprotect Password:=PW
    Worksheets("Recorders").Range("AJ27:AJ28").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Worksheets("Recorders").Range("A20:J21").AutoFilter
    ActiveSheet.Protect Password:=PW
'
    'Copy Quantity of HDDtype & Camconnect to Equipment list
    Worksheets("Recorders").Unprotect Password:=PW
    Worksheets("Recorders").Range("AK27:AK28").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
    Range("B" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
    'Copy HDD & Camconnect article number type to Equipment list
    Worksheets("Recorders").Unprotect Password:=PW
    Worksheets("Recorders").Range("AL27:AL28").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    Range("C" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
'********************************************************************************************
'Accesories page
     Worksheets("Accesories list").Unprotect Password:=PW
    ' Clear_Short Accesories list
    Worksheets("Accesories list").Range("G5:I75").ClearContents
    'Generate Short Accesories list
    'Filter accesories list where quanity is not 0 and copy to Accesories list
    Worksheets("Accesories list").Range("B4:D4").AutoFilter
    Worksheets("Accesories list").Range("$B$4:$D$75").AutoFilter Field:=2, Criteria1:=">0", _
        Operator:=xlAnd
    'Copy filtered data from colum B to first empty line in Equipment list sheet
    Worksheets("Accesories list").Range("B5:B75").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
'Copy filtered data from colum A to first empty line in Equipment list sheet
    Worksheets("Accesories list").Unprotect Password:=PW
    Worksheets("Accesories list").Range("C5:C75").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "B").End(xlUp).Row
    Range("B" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    ActiveSheet.Protect Password:=PW
'
'Copy filtered data from colum A to first empty line in Equipment list sheet
    Worksheets("Accesories list").Unprotect Password:=PW
    Worksheets("Accesories list").Range("D5:D75").Copy
    Worksheets("Equipment list").Select
    lMaxRows = Cells(Rows.Count, "C").End(xlUp).Row
    Range("C" & lMaxRows + 1).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False

'
    Worksheets("Accesories list").Range("B4:D4").AutoFilter

'
'********************************************************************************************
' select Cel A1 on Equipment page with cursor
    Worksheets("Equipment list").Range("A1").Select
    Application.ScreenUpdating = True
    ActiveSheet.Protect Password:=PW
End Sub

hoe komt het dat ik nu die foutmaldingen krijg?
kan ik misschien met een simple code all mijn sheets gelijktijdig 'Unprotect' en 'Protect' maken, bij het bedin en einde van elk script?
 
Je kunt in de thisworkbookmodule alle werkbladen programmatisch beveiligen met de switch UserInterFaceOnly waardoor VBA er geen last van heeft:
Code: 
Private Sub Workbook_Open()
    Dim Sh As Object
    
    For Each Sh In Sheets
        Sh.Protect Password:="Test", UserInterfaceOnly:=True, AllowFiltering:=True
    Next
End Sub
 
@Timshel: met jouw voorstel kom ik er niet uit. sorry.
ik heb ondertussen nog wat verder kunnen zoeken, en momenteel lukt het wel gedeeltelijk met dit script.
Code: 
Sub Uitvoeren()
    Call Onbeveiligd
        'voer jouw code uit
    Call Beveiligd
End Sub
Sub Onbeveiligd()
    Dim sh As Worksheet
        For Each sh In ThisWorkbook.Sheets
            sh.Unprotect Password:="test"
        Next
End Sub
Sub Beveiligd()
    Dim sh As Worksheet
        For Each sh In ThisWorkbook.Sheets
            sh.Protect Password:="test"
        Next
End Sub

maar eigenaardig genoeg, krijg ik nu foutmeldingen 'in' mijn reeds bestaande formules, waarbij ik voorheen geen fouten had. (hier is niets aan gewijzigd)
zie mijn voorgaande post (1MaxRows = Variable not found?)
 
Bjorkie zei:
1MaxRows = Variable not found?
Code: 
Option Explicit...

hoe komt het dat ik nu die foutmaldingen krijg?
Klik om te vergroten...

zie post #2
Dim lmaxrows as long
Bjorkie zei:
kan ik misschien met een simple code all mijn sheets gelijktijdig 'Unprotect' en 'Protect' maken, bij het bedin en einde van elk script?
Klik om te vergroten...

Kijk nog eens naar de veel handigere code uit post#4
Even opslaan, afsluiten en weer openen
 
hey allen,
bedankt voor de feedback. ik ben er voorlopig uit.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan