Blattschutz aus VBA-Programmierung entfernen?
20.01.2005 22:06:31
Christoph
wenn man diese Arbeitsblatt in Excel kopiert, ist es immer mit einem Blatschutz versehen. Wie kann ich diesen aus der VBA-Programmierung entfernen? Welcher Code deutet auf Balltschutz siehe VBA-Proggramierung unten auf dieses hin?
Vielen Dank
Gruß Christoph
Sub addgruppe()
' addgruppe Makro
' Makro am 13.01.2003 von Wolfgang Lichti aufgezeichnet
Dim gn As String
Application.ScreenUpdating = False
gn = InputBox("Geben Sie die Nummer der neuen Gruppe ein:", "Gruppennummer")
If gn = "" Then GoTo Ende
If ExistSheet(gn) = True Then GoTo Ende
If SheetNotValid(gn) = True Then GoTo Ende
Sheets("Beispiel").Activate
Sheets("Beispiel").Copy After:=Sheets("Beispiel")
Sheets("Beispiel (2)").Activate
ActiveSheet.Name = gn
ActiveSheet.Visible = True
ActiveSheet.Unprotect "xeppo"
ActiveSheet.Range("N4").Value = gn
ActiveSheet.Protect "xeppo"
Worksheets("Auswertung").Select
Worksheets("Auswertung").Unprotect "xeppo"
Rows("8:8").Select
Selection.Insert Shift:=xlDown
Range("B7:O7").Select
Selection.Copy
Range("B8:O8").Select
Application.CutCopyMode = False
Range("B8").Select
ActiveSheet.Range("b8").Value = gn
Range("D8").Select
ActiveCell.Value = "=" & gn & "!$I$7"
Range("E8").Select
ActiveCell.Value = "=" & gn & "!$J$46"
Range("F8").Select
ActiveCell.Value = "=" & gn & "!$H$46"
Range("G8").Select
ActiveCell.Value = "=" & gn & "!$O$26"
Range("H8").Select
ActiveCell.Value = "=" & gn & "!$O$27"
Range("I8").Select
ActiveCell.Value = "=" & gn & "!$O$30"
Range("J8").Select
ActiveCell.Value = "=" & gn & "!$O$28"
Range("K8").Select
ActiveCell.Value = "=" & gn & "!$O$45"
Range("L8").Select
ActiveCell.Value = "=" & gn & "!$O$46"
Range("M8").Select
ActiveCell.Value = "=" & gn & "!$O$42"
Range("N8").Select
ActiveCell.Value = "=" & gn & "!$O$41"
Range("O8").Select
ActiveCell.Value = "=" & gn & "!$O$43"
Range("b8").Select
Worksheets("Beispiel").Protect "xeppo"
Worksheets("Muster").Visible = False
Ende:
Worksheets("HOME").Select
Application.ScreenUpdating = True
End Sub
Function ExistSheet(gn)
Dim s As Integer
ExistSheet = False
For s = 1 To ThisWorkbook.Worksheets.Count
If Worksheets(s).Name = gn Then
ExistSheet = True
MsgBox "Blattname " & sn & " existiert bereits!"
Exit For
End If
Next s
End Function
Function SheetNotValid(gn)
Dim NameBak As String
SheetNotValid = False
On Error GoTo Fehler
NameBak = ActiveSheet.Name
ActiveSheet.Name = gn
ActiveSheet.Name = NameBak
Exit Function
Fehler:
SheetNotValid = True
MsgBox "Die eingegebene Schlag-Nr. enthält ein ungültiges Zeichen!"
End Function