Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema ListBox
Screenshot zu ListBox	ListBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema SpinButton
Screenshot zu SpinButton	SpinButton-Seite mit Beispielarbeitsmappe aufrufen

erledigte verschieben trotz Blattschutz

• erledigte verschieben trotz Blattschutz von Erik vom 08.09.2020 09:10:30
• AW: erledigte verschieben trotz Blattschutz - von Herbert_Grom am 08.09.2020 09:53:37
  • AW: erledigte verschieben trotz Blattschutz - von Erik am 08.09.2020 16:31:30

Betrifft: erledigte verschieben trotz Blattschutz von: Erik
Geschrieben am: 08.09.2020 09:10:30

Hallo Excel Spezialisten,

dank eure hilfe habe ich meine tabelle endlich so gestalltet wie ich mir wünsche.
Nun möchte ich die Tabelle Schützen.

Gibt es die möglichkeit " nicht gesperrte Zellen B bis Y" bearbeitet werden kann und ich trotz Blattschutz mein "erledigte aufgaben verschieben auf anderen Tabellenblatt" funktion und autom.sortieren noch nutzen kann?
Der Blattschutz in Excel ist in Ordnung, aber da beide Blätter geschützt sind, kann ich die erledigten nicht verschieben.

Gruß

  

Betrifft: AW: erledigte verschieben trotz Blattschutz
von: Herbert_Grom
Geschrieben am: 08.09.2020 09:53:37

Hallo Erik,

füge vor dem Verschieben eine "ActiveSheet.Unprotect" "Passwort" und danach ein "ActiveSheet.Protect", ein.

Servus

  

Betrifft: AW: erledigte verschieben trotz Blattschutz
von: Erik
Geschrieben am: 08.09.2020 16:31:30

Hallo Herbert,
wo soll der Code genau hin?

In die Tabellenblatt oder in die Makro?


Aktuel benutze ich diesen Code.
Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long

Private Const FOLDER_PATH As String = "C:\

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objRange As Range, objcell As Range
    Dim lngReturn As Long
    If Target.Column = 13 And Target.Row > 12 Then
       Call ProjektArchivieren(Target)
        Range("M12").CurrentRegion.Sort Key1:=Range("M12"), _
            Order1:=xlAscending, Header:=xlYes, _
            OrderCustom:=1, MatchCase:=False, _
            Orientation:=xlTopToBottom
    Else
        Set objRange = Intersect(Target, Columns(2))
        If Not objRange Is Nothing Then
            For Each objcell In objRange
                If Not IsEmpty(objcell.Value) Then
                    lngReturn = MakeSureDirectoryPathExists(FOLDER_PATH & _
                        Replace(Replace(objcell.Text, "/", "-"), "-", "_") & "\")
                    If lngReturn = 0 Then Call MsgBox("Ordner " & objcell.Text & _
                        " konnte nicht erstellt werden.", vbCritical, "Dateisystemfehler")
                End If
            Next
            Set objRange = Nothing
        End If
    End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim strFoldername As String, strAlternativeFoldername As String
    If Target.Column = 2 Then
        strAlternativeFoldername = Replace(Replace(Target.Text, "/", "-"), "-", "_")
        strFoldername = Dir$(FOLDER_PATH & "*" & _
            Replace(Target.Text, "/", "-") & "*", vbDirectory)
        If strFoldername = vbNullString Then strFoldername = _
            Dir$(FOLDER_PATH & "*" & strAlternativeFoldername & "*", vbDirectory)
        If strFoldername <> vbNullString Then
            Call Shell("explorer.exe /e, " & FOLDER_PATH & strFoldername, vbNormalFocus)
        Else
            Call MsgBox("Ordner nicht gefunden.", vbExclamation, "Hinweis")
        End If
        Cancel = True
    End If
End Sub

Beiträge aus dem Excel-Forum zum Thema "erledigte verschieben trotz Blattschutz"