Namensänderung Tabellenblätter
Claudia
ich habe hier in der Fa. ein großes Programm mit vielen ausgeblendeten und eingeblendeten Tabellenblättern. Die Arbeitsmappen sind mittels VBA geschützt, Passwort bekannt.
Jetzt mein Problem: Da man bei einer geschützen Arbeitsmappe die Blätter nicht umbenennen kann und das Passwort des Arbeitsmappenschutzes nicht öffentlich gemacht werden darf möchte ich ein kleines Prog. integrieren welches nur immer die Eingeblendeten Tabellenblätter auflistet, man eines dieser Blätter auswählen muss/kann/darf und man dann nur diesem soeben ausgewählten Blatt einen neuen Namen geben darf. Nach Beendigung des Umbenennens wird dann der Arbeitsmappenschutz wieder gesetzt. Ich hoffe das man meinem Wortlaut folgen kann.
Zum Sperren und Entsperren werden die nachstehenden Makros abgerufen:
Option Explicit
Option Private Module
Public Const cPassword As String = "Passwort_ist_bekannt"
'Datei wird gesperrt
Private Sub Protect()
Dim shp As Shape
Dim intWs As Integer
Call doObjects(True)
wsInit.Range("Sprache").ClearContents
With ThisWorkbook
.UnProtect Password:=cPassword
'Call Save_Product_Info
With .Worksheets(1)
.Activate
.UnProtect Password:=cPassword
.Visible = True
For Each shp In .Shapes
If shp.Type msoOLEControlObject Then
shp.Delete
End If
Next shp
End With
For intWs = 2 To .Worksheets.Count
With .Worksheets(intWs)
.UnProtect Password:=cPassword
.Protect Password:=cPassword
.Visible = xlVeryHidden
End With
Next intWs
.Protect Password:=cPassword
End With
With ThisWorkbook.Worksheets("Init")
.Range("Sprache").ClearContents
.Range("Tageslinie").Value = True
.Range("Wochenende").Value = True
.Range("Kritischer_Pfad").Value = True
.Range("Anpassen_1_Seite").Value = True
.Range("Druckbereich_anpassen").Value = False
.Range("Objekte").Value = False
End With
a.EnableEvents = True
a.ScreenUpdating = True
bolUpdate = False
End Sub
Private Sub UnProtect()
Dim ws As Worksheet
Set a = Application
With ThisWorkbook
.UnProtect Password:=cPassword
For Each ws In .Worksheets
With ws
.Visible = True
.UnProtect Password:=cPassword
.Cells.EntireColumn.Hidden = False
End With
Next ws
End With
a.EnableEvents = True
a.ScreenUpdating = True
End Sub
Liebe Grüße
Claudia