Gruß
If ActiveWorkbook.ReadOnly Then
MsgBox ("Datei ist Schreibgeschützt es ist keine Anforderung durchführbar")
End
End If
Grüße,
Sub Userform_oeffnen()
Sheets("Anforderungen").Unprotect Password:="39wPqg2h"
ActiveSheet.Shapes("Button 21").Select
Selection.Characters.text = "Neue Anforderung erstellen"
With Selection.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
'.TintAndShade = 0
'.ThemeFont = xlThemeFontNone
End With
Range("D1").Select
Sheets("Anforderungen").Protect Password:="39wPqg2h"
Anforderung_erstellen.Show
End Sub
Sub Userform_oeffnen()
If ActiveWorkbook.ReadOnly Then
MsgBox ("Datei ist Schreibgeschützt es ist keine Anforderung durchführbar")
End
End If
Sheets("Anforderungen").Unprotect Password:="39wPqg2h"
ActiveSheet.Shapes("Button 21").Select
Selection.Characters.text = "Neue Anforderung erstellen"
With Selection.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
'.TintAndShade = 0
'.ThemeFont = xlThemeFontNone
End With
Range("D1").Select
Sheets("Anforderungen").Protect Password:="39wPqg2h"
Anforderung_erstellen.Show
End Sub
Möchtest du den restlichen Code kommentiert haben? Der ist nämlich ... verbesserungswürdig.
Sub Userform_oeffnen()
If ActiveWorkbook.ReadOnly Then
MsgBox ("Datei ist Schreibgeschützt es ist keine Anforderung durchführbar")
Else
With Sheets("Anforderungen")
.Unprotect Password:="TEST1"
With .Shapes("Button 21").TextFrame.Characters
.Text = "Neue Anforderung erstellen"
With .Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
End With
End With
.Protect Password:="TEST1"
Anforderung_erstellen.Show
End If
End Sub
Du siehst, ich habe auf die relativ brutale "End" Anweisung verzichtet und stattdessen den gesamten Code innerhalb der IF-THEN-ELSE Abfrage nach dem Schreibschutz untergebracht. Die Referenzierungen auf die Tabelle habe ich in WIDTH-Rahmen ausgelagert (Es passiert doch alles auf dem Blatt "Anforderungen", oder?), ebenso alle weiteren Referenzierungen. Die Select und Selection des Rekorders habe ich rausgeworfen.
Sub Userform_oeffnen()
If ActiveWorkbook.ReadOnly Then
MsgBox ("Datei ist Schreibgeschützt es ist keine Anforderung durchführbar")
Else
With Sheets("Anforderungen")
.Unprotect Password:="TEST1"
With .Shapes("Button 21").TextFrame.Characters
.Text = "Neue Anforderung erstellen"
With .Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
End With
End With
.Protect Password:="TEST1"
End With
Anforderung_erstellen.Show
End If
End Sub
Klaus