passwortschutz verhindert makroausführung

Hallo zusammen,
ich hatte vor einige Zeit ein Problem welches in diesem Forum gelöst wurde und auch gut funzt.
Leider hat sich mittlerweile gezeigt das ich das Tabellenblatt mit welchem ich arbeite mit einem Passwortschutz versehen muss. Es sind auf dem Tabellenblatt nur einige Zellen freigegeben, der Rest ist gesperrt, unter anderem auch die Zelle mit dem Datum sowie die Sverweis Zellen.
Hab mal probiert diese Zellen freizugeben, aber das geht auch nicht so lange die Tabelle geschützt ist.
Nun hab ich aber das Problem dass das Makro nicht läuft wenn das Tabellenblatt gesperrt ist.
Will heißen bei jedem Datumssprung kommt eine Fehlermeldung des entsprechenden Makros:
"Fehler in Prozedur Sub 'Worksheet_Calculate'
Fehlernummer 1004"
Die ursprüngliche Lösung ist in einer bereits hochgeladenen Datei ersichtlich.
Leider kann ich das hier nicht verlinken, aber sucht mal bitte im Forumsarchiv unter:
Sverweis auf Dateien mit wechslenden Dateinamen
Kann mir hier jemand weiter helfen?
Auch Blick ich bei dem Makro von Sepp nur teilweise durch. Ist für meine geringen VBA-Kenntnisse zu hoch....
Danke schon mal.
Gruß Heinz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

For lngIndex = 1 To UBound(vntLink) strNewLink = regReplace(vntLink(lngIndex), " [0-9]{4}", strReplace) If strNewLink CStr(vntLink(lngIndex)) Then If Dir(strNewLink) = "" Then MsgBox "Datei" & vbLf & strNewLink & vbLf & "nicht gefunden", _ vbCritical, "Worksheet_Calculate" Else ThisWorkbook.ChangeLink Name:=vntLink(lngIndex), _ NewName:=strNewLink, Type:=xlExcelLinks End If End If Next

Hi Heinz,
warum hast du nicht gleich im ersten Beitrag des Text geschrieben, der zu dem Fehler 1004 ausgegeben wird?
"Dieser Befehl kann für ein geschütztes Blatt nicht verwendet werden..."
Wie sieht dein vergeblicher Versuch mit Unprotect und Protect genau aus?
Du hast oben mal geschrieben: "Das mit Unprotect und Protect kenne ich. Hab ich auch probiert, funzt aber leider nicht."
"funzt nicht" ist eine recht sparsame Fehlerbeschreibung...
Probier mal


Option Explicit
Private Sub Worksheet_Calculate()
Dim vntLink As Variant, lngIndex As Long
Dim strReplace As String, strNewLink As String
On Error GoTo ErrExit
Me.Unprotect "test"
If IsDate(Range("U1")) Then
If GetCustProp("LinkYear", Year(Range("U1")))  Year(Range("U1")) Then
SetCustProp "LinkYear", Year(Range("U1"))
strReplace = " " & Year(Range("U1"))
vntLink = ThisWorkbook.LinkSources
If Not IsEmpty(vntLink) Then
For lngIndex = 1 To UBound(vntLink)
strNewLink = regReplace(vntLink(lngIndex), " [0-9]{4}", strReplace)
If strNewLink  CStr(vntLink(lngIndex)) Then
If Dir(strNewLink) = "" Then
MsgBox "Datei" & vbLf & strNewLink & vbLf & "nicht gefunden", _
vbCritical, "Worksheet_Calculate"
Else
Application.EnableEvents = False
ThisWorkbook.ChangeLink Name:=vntLink(lngIndex), _
NewName:=strNewLink, Type:=xlExcelLinks
End If
End If
Next
End If
End If
End If
ErrExit:
With Err
If .Number  0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "Sub 'Worksheet_Calculate'" & _
vbLf & String(40, "=") & vbLf & vbLf & _
IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & _
vbTab & .Description & vbLf, vbExclamation, "Fehler in Modul - Tabelle1"
.Clear
End If
End With
Me.Protect "test"
Application.EnableEvents = True
On Error GoTo 0
End Sub

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Beliebteste Forumthreads (12 Monate)

passwortschutz verhindert makroausführung

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

passwortschutz verhindert makroausführung

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread