Office: (Office 2010) VBA

Chillor · 5. Januar 2016

Hallo alle zusammen.

ich habe eine Datei, die gelegentlich zeitgleich von anderen mit Schreibschutz geöffnet wird. bei dem Parallelöffnen soll nun überprüft werden ob Schreibschutz aktiev ist, da das der Fall ist sollen alle Arbeitsblätter mit Blattschutz versehen werden (kein Bearbeiten jeglicher Zellen möglich, die Möglichkeit der Auswahl, Autofilter, Suchen, Kopieren soll bestehen bleiben.

Bei dem Versuch was einzugeben soll eine MsgBox erscheinen mit Hinweis zB. "kein Bearbeiten möglich!!!"

Code:

Private Sub Workbook_open()
'prüfen ob Schreibschutz
With ActiveWorkbook
If .ReadOnly Then
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoSelection
End If
End With

'für alle Blätter mit Passwortschutz
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect userinterfaceonly:=True
ws.EnableAutoFilter = True 'ermöglicht Autofilter
ws.EnableOutlining = True 'ermöglicht Gruppierung/Gliederung
Next ws
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

hier mein code, ABER ich kann nichts auswählen und wenn ich "ActiveSheet.EnableSelection = xlNoSelection" lösche ist immernoch keine Auswahl möglich. die MsgBox fehlt auch noch

:)

Chillor · 7. Januar 2016

kann mir keiner weiterhelfen??? *bawling

Chillor · 10. Januar 2016

das muss doch möglich sein, der Ansatz funktioniert ja, den Rest bekomme ich einfach nicht hin.

Chillor · 11. Januar 2016

das viele Suchen und recherchieren hat sich am Ende nun doch gelohnt.
habe das Problem nun anderster gelöst, hier der Code für die die es interessiert

Code:

Private Sub Workbook_open()

'prüfen ob Schreibschutz aktiev dann MsgBox
If ActiveWorkbook.ReadOnly = True Then
Dim Text1 As String
Dim Text2 As String
Text1 = "Die Datei ist schreibgeschützt geöffnet,"
Text2 = "bitte keine Fabrik-Nummern vergeben!!!"
MsgBox Text1 & vbLf & Text2, , "ACHTUNG"
End If

'für alle Blätter mit Passwortschutz
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect userinterfaceonly:=True
ws.EnableAutoFilter = True 'ermöglicht Autofilter
ws.EnableOutlining = True 'ermöglicht Gruppierung/Gliederung
Next ws

...
...
...

'beim Schließen wenn im Schreibschutz geöffnet kein Speichern
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Blatt As Object
If Me.ReadOnly = True And Me.Saved = False Then
Dim Text1 As String
Dim Text2 As String
Text1 = "Die Datei ist schreibgeschützt geöffnet,"
Text2 = "Sie dürfen diese Datei nicht speichern!"
MsgBox Text1 & vbLf & Text2, , "ACHTUNG"
End If
VBA.SendKeys "+N" 'Sendet Alt+N (Nein) an die Sicherheitsabfrage

End Sub

'beim Speichern wenn im Schreibschutz geöffnet kein Speichern
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Me.ReadOnly = True And Me.Saved = False Then
Dim Text1 As String
Dim Text2 As String
Text1 = "Die Datei ist schreibgeschützt geöffnet,"
Text2 = "bitte keine Fabrik-Nummern vergeben!!!"
MsgBox Text1 & vbLf & Text2, , "ACHTUNG"
Cancel = True
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: (Office 2010) VBA

VBA

VBA

VBA

VBA - Similar Threads - VBA

VBA in einer Zeile zu lang

Listbox wird nicht breiter, Schriftgrösse ändert sich

Kontrollkästchen aktivieren ohne VBA - wenn KK1 angekreuzt dann KK2 auch

Per Hyperlink ausgeblendetes Blatt einblenden

Bilder über VBA Größe und DPI ändern für Webshop

VBA: Platzhalter ersetzen und evtl. leere Zeile einfügen

Erstellung eines Dynamischen Kalenders (ggf. VBA)