Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
884to888
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
884to888
884to888
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Alle Zellen sperren und zwischenspeichern

Alle Zellen sperren und zwischenspeichern
09.07.2007 16:14:00
Salim
Hallo Zusammen,
mir fällt nichts mehr ein ;( Habe alles versucht aber irgendwo funktioniert es nicht!
Ich möchte eigentlich nur eine Datei zwischenspeichern in der alle Zellen aller Tabellenblätter gesperrt werden, quasi nur zum anschauen. Wollte eigentlich dass die Zwischenspeicherung dann automatisch geschlossen wird, so dass die unveränderte Originalfassung geöffnet bleibt. Wäre für einen Tipp dankbar ;)

Sub Speichern()
Dim wks As Worksheet
Dim rng As Range
With Worksheets("Tabelle1")
strDateiname = ThisWorkbook.Path & "\" & .Range(" J4") & "_" & .Range("R8") & "_" & .Range(" _
R6") & "_" & "Backup" & "_" & Format(Date, "YYYYMMDD") & ".xls"
End With
ActiveWorkbook.SaveCopyAs strDateiname
Workbook.Name = strDateiname.Open
ActiveWorkbook.Unprotect
For Each wks In Worksheets
wks.Unprotect
For Each rng In ActiveSheet.UsedRange.Cells
If Not IsEmpty(rng) Then rng.Locked = True
Next rng
wks.Protect
Next wks
ActiveWorkbook.Protect
ActiveWorkbook.Close
End Sub


Gruss
Salim

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Alle Zellen sperren und zwischenspeichern
09.07.2007 22:54:18
fcs
Hallo Salim,
mit folgenden Anpassungen funktionierts. Zwecks besser Übersichtlichkeit hab ich Activesheet und ActiveWorkbook durch entsprechende Objektvariablen ersetzt.
Gruß
Franz

Sub Speichern()
Dim wks As Worksheet, wbThis As Workbook, wbSave As Workbook
Dim rng As Range
Set wbThis = ThisWorkbook
With wbThis.Worksheets("Tabelle1")
strDateiname = ThisWorkbook.Path & "\" & .Range(" J4") & "_" & .Range("R8") & "_" & _
.Range("R6") & "_" & "Backup" & "_" & Format(Date, "YYYYMMDD") & ".xls"
End With
wbThis.SaveCopyAs strDateiname
Set wbSave = Workbooks.Open(FileName:=strDateiname)
wbSave.Unprotect
For Each wks In wbSave.Worksheets
wks.Unprotect
For Each rng In wks.UsedRange.Cells
If Not IsEmpty(rng) Then rng.Locked = True
Next rng
wks.Protect
Next wks
wbSave.Protect
wbSave.Close savechanges:=True
End Sub


Anzeige
AW: Alle Zellen sperren und zwischenspeichern
10.07.2007 09:29:00
Salim
Hallo Frankz,
vielen Dank für die Hilfe.
Ich wollte den Code etwas abändern und jetzt kommt die Fehlermeldung: Die Locked Eigenschaft desRange-Objektes kann nicht festgelegt werden. Der Befehl rng.Locked = True wird markiert.

Private Sub CommandButton1_Click()
Me.Hide
Dim wks As Worksheet, wbThis As Workbook, wbSave As Workbook
Dim rng As Range
Set wbThis = ThisWorkbook
With wbThis.Worksheets("Abrechnungsblatt")
strDateiname = ThisWorkbook.Path & "\" & .Range(" J4") & "_" & .Range("R8") & "_" & _
.Range("R6") & "_" & "Backup" & "_" & Format(Date, "YYYYMMDD") & ".xls"
End With
wbThis.SaveCopyAs strDateiname
Set wbSave = Workbooks.Open(Filename:=strDateiname)
wbSave.Unprotect
For Each wks In wbSave.Worksheets
wks.Unprotect
For Each rng In wks.UsedRange.Cells
If Not IsEmpty(rng) Then rng.Locked = True
Next rng
wks.Protect
Next wks
wbSave.Protect
wbSave.Close savechanges:=True
End Sub


Kannst du es verstehen? Wäre Dankbar für ein zweites Feedback!
Übrigens, wäre es möglich, falls die Zwischenspeicherung geöffnet ist und man versucht eine Speicherung zu tätigen, dass ein MsgBox erscheint, dass man die Zwischenspeicherung zuerst schliessen muss? Herzlichen Dank für deine Unterstützung.
Gruss
Salim

Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige