Sortierung auf geschütztem Blatt

Public Sub ProtectSheets(Optional pSheetName As String = "") Dim ws As Worksheet If pSheetName = "" Then Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets With ws .Protect _ UserInterfaceOnly:=True, _ AllowSorting:=True, _ AllowFiltering:=True .EnableAutoFilter = True .EnableOutlining = True .EnableSelection = xlUnlockedCells End With Next ws Application.ScreenUpdating = True Else With Sheets(pSheetName) .Protect _ UserInterfaceOnly:=True, _ AllowSorting:=True, _ AllowFiltering:=True .EnableAutoFilter = True .EnableOutlining = True .EnableSelection = xlUnlockedCells End With End If End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub SaveDirectory() Dim FilePath As String With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "C:\" .Title = "Rechnungsordner auswählen" .ButtonName = "Auswählen" .InitialView = msoFileDialogViewList If .Show = -1 Then FilePath = .SelectedItems(1) If Right(FilePath, 1) "\" Then FilePath = FilePath & "\" Else FilePath = "" End If End With If FilePath = "" Then MsgBox ("Kein Ordner gewählt!") Else Call UnprotectSheets("Verknüpfungen") Sheets("Verknüpfungen").Range("B27").Value = FilePath Sheets("Verknüpfungen").Range("B28").Value = Now Call ProtectSheets("Verknüpfungen") MsgBox ("Der Ordner wurde eingebunden.") End If End Sub

Option Explicit Public Sub SaveDirectory() Dim FilePath As String With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "C:\" .Title = "Rechnungsordner auswählen" .ButtonName = "Auswählen" .InitialView = msoFileDialogViewList If .Show = -1 Then FilePath = .SelectedItems(1) End With If Right(FilePath, 1) "\" Then FilePath = FilePath & "\" Else FilePath = "" End If If FilePath = "" Then MsgBox ("Kein Ordner gewählt!") Else Call UnprotectSheets("Verknüpfungen") Sheets("Verknüpfungen").Range("B27").Value = FilePath Sheets("Verknüpfungen").Range("B28").Value = Now Call ProtectSheets("Verknüpfungen") MsgBox ("Der Ordner wurde eingebunden.") End If End Sub

Hallo,
ich würde das so machen:

Public Sub SaveDirectory()
    Dim FilePath As String
    Dim objTargetSheet As Worksheet
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Rechnungsordner auswählen"
        .ButtonName = "Auswählen"
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            FilePath = .SelectedItems(1) & "\" 'bei Ordnern immer !!!
            Set objTargetSheet = Worksheets("Verknüpfungen")
            Call UnprotectSheets(objTargetSheet)
            With objTargetSheet
                .Range("B27").Value = FilePath
                .Range("B28").Value = Now
            End With
            Call ProtectSheets(objTargetSheet)
            Set objTargetSheet = Nothing
            MsgBox ("Der Ordner wurde eingebunden.")
        Else
            MsgBox "Kein Ordner gewählt!"
        End If
    End With
End Sub

Public Sub ProtectSheets(Optional ByRef pSheet As Worksheet)
    Dim ws As Worksheet

    If pSheet Is Nothing Then
        Application.ScreenUpdating = False
        For Each ws In ThisWorkbook.Worksheets
            With ws
                .Protect _
                    UserInterfaceOnly:=True, _
                    AllowSorting:=True, _
                    AllowFiltering:=True
                .EnableAutoFilter = True
                .EnableOutlining = True
                .EnableSelection = xlUnlockedCells
            End With
        Next ws
        Application.ScreenUpdating = True
    Else
        With pSheet
            .Protect _
                UserInterfaceOnly:=True, _
                AllowSorting:=True, _
                AllowFiltering:=True
            .EnableAutoFilter = True
            .EnableOutlining = True
            .EnableSelection = xlUnlockedCells
        End With
    End If
End Sub

Noch besser wäre es, wenn du direkt mit dem Objektnamen der Tabellen arbeiten würdest. Die Objektnamen findest du im Projektexplorer vor dem in Klammern stehenden Tabellennamen auf der Exceloberfläche. Das ist erstens schneller da du nicht über den Umweg der Auflistungsklasse gehen musst, und zweites macht es dich unabhängig von dem Tabellennamen welchen der User sieht. Der darf also ruhig Tabellen umbenennen, dein Programm greift trotzdem auf die richtigen Tabellen zu. Drittens bekommst du direkt beim kompilieren des Codes eine Fehlermeldung falls sich eine Tabelle nicht mehr in der Mappe befindet, das hast du beim Benutzen der Auflistungsklassen nicht.
Wenn z.B. deine Tabelle "Verknüpfungen" den Objektnamen "Tabelle3" hat, dann einfach so:

Public Sub SaveDirectory()
    Dim FilePath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\"
        .Title = "Rechnungsordner auswählen"
        .ButtonName = "Auswählen"
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            FilePath = .SelectedItems(1) & "\" 'bei Ordnern immer !!!
            Call UnprotectSheets(Tabelle3)
            With Tabelle3
                .Range("B27").Value = FilePath
                .Range("B28").Value = Now
            End With
            Call ProtectSheets(Tabelle3)
            MsgBox ("Der Ordner wurde eingebunden.")
        Else
            MsgBox "Kein Ordner gewählt!"
        End If
    End With
End Sub

Wobei ich den Objektnamen der Tabelle z.B. auf tabCatenation ändern würde. Damit siehst du im Code sofort, dass hier auf eine Tabelle zugegriffen wird, und welche Funktion die Tabelle hat (entschuldige dass ich grundsätzlich alles in englisch halte was Programme betrifft, aber das habe ich so gelernt). Ändern kannst du den Namen im Eigenschaftsfenster ganz oben.
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Sortierung auf geschütztem Blatt

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread