Geblokkeerd kopieren/knippen tijdelijk deblokkeren

[ewaldmauritz]

Ik van internet de volgende macro's gevonden om kopiëren/knippen te blokkeren. Ze staan in Thisworkbook.

Private Sub Workbook_Activate()
Dim oCtrl As Office.CommandBarControl
'Disable all Cut menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.Enabled = False
     Next oCtrl
'Disable all Copy menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.Enabled = False
     Next oCtrl
        Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_Deactivate()
Dim oCtrl As Office.CommandBarControl
'Enable all Cut menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.Enabled = True
     Next oCtrl
'Enable all Copy menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.Enabled = True
     Next oCtrl
        Application.CellDragAndDrop = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    With Application
        .CellDragAndDrop = False
        .CutCopyMode = False 'Clear clipboard
    End With
End Sub

Op zich werkt dat prima, maar ik heb een macro die zelf kopieert en plakt. Dat is de volgende (staat in de werkbladmodule Blad1 Planning):

Sub Sorteer_projecttrekker()
    Sheets("Uren per dag").Select
Call Uren_kopieren
Call Verticaal_zoeken
    Sheets("Planning").Select
    Range("A12:BG41").Select
    ActiveWorkbook.Worksheets("Planning").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Planning").Sort.SortFields.Add Key:=Range( _
        "A12:A41"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Planning").Sort.SortFields.Add Key:=Range( _
        "B12:B41"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Planning").Sort
        .SetRange Range("A12:BG41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Uren per dag").Select
Call Plakken_als_waarden
Call Hulpoutput_verwijderen
    Sheets("Planning").Select
    Range("A12").Select
Call Lege_rijen_planning_verbergen
End Sub

Die macro werkte goed, maar nu de macro's om het kopiëren/knippen te blokkeren zijn toegevoegd, krijg ik een 400-foutmelding. Waarschijnlijk omdat het kopieren/knippen is geblokkeerd. Nu wil ik het kopiëren/knippen dus tijdens het draaien van de macro Sub Sorteer_projecttrekker tijdelijk deblokkeren. Aan het einde van de macro kan het kopiëren/knippen weer worden geblokkeerd.

Ik heb het volgende daarom al geprobeerd:
1. Op de eerste regel van Sub Sorteer_projecttrekker heb ik toegevoegd: Call ThisWorkbook.Workbook_Deactivate --> ik krijg dan een compileerfout.
2. Daarom heb ik in de macro's in Thisworkbook Private veranderd in Public. Maar dan krijg ik een 400-foutmelding.

Wat doe ik fout? Hoe moet ik een macro in Thisworkbook aanroepen in een werkbladmodule? En waar komt die 400-foutmelding vandaan?

 

[tkint]

Beste,

Heb je al geprobeerd om met de programmeerregels voor het deblokkeren van kopiëren/knippen in de andere macro te plakken, de foutmeldingen te vermijden?

 

[edmoor]

Doe het eens zo:

Private Sub Workbook_Deactivate()
    Application.Run "EnableControls"
End Sub

'Deze in een module
Private Sub EnableControls
    Dim oCtrl As Office.CommandBarControl

    'Enable all Cut menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.Enabled = True
     Next oCtrl

     'Enable all Copy menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.Enabled = True
     Next oCtrl

     Application.CellDragAndDrop = True
End Sub

Die Application.Run "EnableControls" opdracht kan je dan overal vandaan uitvoeren.

 

[ewaldmauritz]

Dat heb ik inderdaad geprobeerd, maar dat lukt niet. Ik heb de volgende macro gemaakt in mijn werkbladmodule:

Sub Enable_all_menus()
Dim oCtrl As Office.CommandBarControl
'Enable all Cut menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.Enabled = True
     Next oCtrl
'Enable all Copy menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.Enabled = True
     Next oCtrl
        Application.CellDragAndDrop = True
End Sub

In mijn eigen macro heb ik vervolgens gezet: Call Enable_all_menus. Maar ook dan krijg ik een 400-foutmelding.
Het lijkt er op dat mijn macro alleen werkt als de codes om het kopiëren/knippen te blokkeren niet zijn opgenomen.
Feit is ook dat ze automatisch aangeroepen moeten worden bij het openen van het bestand. Dat kan voor zover ik weet alleen via Thisworkbook. Op een of andere manier moet het daarna mogelijk zijn om dat tijdelijk uit te schakelen. De vraag is echter hoe? Of kan je macro's die via Thisworkbook bij het openen van het bestand worden geactiveerd, niet deactiveren in een werkbladmodule?

 

[edmoor]

En wat staat er in het commentaar van de code die ik plaatste?
"'Deze in een module"

Dus niet achter een werkblad.

 

[ewaldmauritz]

Excuus edmoor, mijn bericht was een reactie op tkint. Jouw bericht en mijn bericht hebben elkaar gekruist. Ik las je bericht pas nadat ik mijn bericht had geplaatst.
Ik zal morgen eens kijken of jouw oplossing gaat werken.
Je hoort van me.

 

[edmoor]

Geeft niks

 

[ewaldmauritz]

Helaas is het niet gelukt. Krijg nog steeds een 400-foutmelding. Maar misschien doe ik gewoon iets fout.
Dit staat er in Thisworkbook:

Private Sub Workbook_Activate()
    Application.Run "DisableControls"
End Sub
Private Sub Workbook_Deactivate()
    Application.Run "EnableControls"
End Sub
Public Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    With Application
        .CellDragAndDrop = False
        .CutCopyMode = False 'Clear clipboard
    End With
End Sub

Dit staat er in een module:

Private Sub DisableControls()
Dim oCtrl As Office.CommandBarControl
'Disable all Cut menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.Enabled = False
     Next oCtrl
'Disable all Copy menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.Enabled = False
     Next oCtrl
        Application.CellDragAndDrop = False
End Sub
Private Sub EnableControls()
Dim oCtrl As Office.CommandBarControl
'Enable all Cut menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
            oCtrl.Enabled = True
     Next oCtrl
'Enable all Copy menus
     For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
            oCtrl.Enabled = True
     Next oCtrl
        Application.CellDragAndDrop = True
End Sub

In mijn eigen macro in de werkbladmodule verwijs ik vervolgens zo:
Application.Run "EnableControls"

Is dit wat je bedoelde?

 

[edmoor]

Op zich is dat wat ik bedoelde en ik krijg de foutmelding niet.
Misschien dat je beter even je document kunt plaatsen.

 

[ewaldmauritz]

Dat wordt lastig. Het document is daar veel te groot voor en bestanden met macro's kan ik sowieso niet uploaden.
Is er een andere manier?