Verschillende werkbladen controleren op checkbox

Status
Niet open voor verdere reacties.

Joete

Gebruiker
Lid geworden
19 sep 2008
Berichten
87
Hallo redders in nood,
Ik loop tegen een probleem aan in een prijsvergelijk systeem wat ik voor mijn werk aan het maken ben.

De werkbladen (in mijn huidige bestand 8 stuks, andere bestanden kunnen het meer/minder zijn, daarom een for loopje) zijn beveiligd, daarom heb ik een optie "bewerkmodus" toegevoegd.
De bewerkmodus kan geactiveerd worden door een checkbox (CBBewerk) aan te vinken en dan het wachtwoord in te geven. Hiermee wordt de beveiliging verwijderd en een automatische macro die bij verschillende handelingen loopt uitgeschakeld. Bij het uitvinken van de checkbox komt de beveiliging er weer op en worden alle macro's weer van de beperking afgehaald. Ideaal! Alleen het is niet de bedoeling dat de gene die mag bewerken en dus in het bezit is van het wachtwoord het bestand afsluit in de bewerkmodus...of te wel, ik heb een controle ingebouwd die dit bekijkt en aangeeft hoeveel werkbladen in bewerkmodus zijn en verhinderd dat het bestand gesloten kan worden als het er meer dan 0 zijn.

De code die ik hiervoor gemaakt heb:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' Screenupdating uit
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    ' Controle op bewerkmodus
    Dim WS As Worksheet
    Dim AWS As String
    Dim CB As Integer
    AWS = ActiveSheet.Name
    CB = 0
    
    For Each WS In ActiveWorkbook.Worksheets
        WS.Activate
        If ActiveSheet.CBBewerk.Value = True Then
            CB = CB + 1
        End If
    Next WS
    Sheets(AWS).Activate
    
    If CB = 1 Then
        MsgBox "Er staat nog " & CB & " werkblad in bewerkmodus. Zet deze uit om het bestand af te kunnen sluiten.", vbOKOnly + vbCritical, "Fout voor afsluiten"
        ' Screenupdating aan
        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
            .DisplayAlerts = True
        End With
        Cancel = True
    ElseIf CB > 1 Then
        MsgBox "Er staan nog " & CB & " werkbladen in bewerkmodus. Zet deze uit om het bestand af te kunnen sluiten.", vbOKOnly + vbCritical, "Fout voor afsluiten"
        ' Screenupdating aan
        With Application
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
            .DisplayAlerts = True
        End With
        Cancel = True
    End If
    
    ' Screenupdating aan
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

Dit werkt allemaal, maar niet naar tevredenheid (ongetwijfeld kan de code netter, maar het werkt voor mij).
Waar ik tegenaan loop is dat wanneer alle werkbladen in bewerkmodus zijn de code gewoon snel is en bijna direct de melding geeft. Maar wanneer een werkblad niet in bewerkmodus staat flitst het scherm een aantal keer en moet ie lang nadenken, zeker als het alle 8 de werkbladen betreft.

Ik heb hem nu in de for loop met
Code:
WS.Activate
en dat wil ik eigenlijk niet, maar ik kreeg het anders niet voor elkaar. Ligt het probleem hierin? Kan dit anders? Of denk ik verkeerd en zien jullie een andere oplossing?

Alvast bedankt.
 
Lijkt dit er een beetje op?
Code:
Sub hsv()
Dim sh As Worksheet, ct As OLEObject, teller As Long, nm As String, tekst As String, a As Long
For Each sh In Sheets
   For Each ct In sh.OLEObjects
    If ct.progID = "Forms.CheckBox.1" And ct.Object Then
      nm = sh.Name
      teller = teller + 1
    End If
   Next ct
   If teller > 0 Then tekst = tekst & teller & " open in " & sh.Name & vbLf
  nm = ""
  If a < teller Then a = teller
  teller = 0
 Next sh
  MsgBox "Er " & IIf(a < 2, "staat nog ", "staan nog ") & vbLf & tekst
End Sub
 
Laatst bewerkt:
Dank HSV voor je reactie.

Heb hem even in een ander bestand geplakt, maar wel laten draaien over mijn prijsvergelijk en dat werkt en ook snel! Super!

Nu moet ik hem alleen nog even implementeren in mijn eigen code...komt goed.

Bedankt!
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan