AW: erledigte verschieben trotz Blattschutz
08.09.2020 16:31:30
Erik
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