AW: Makro: Passwortschutz
08.04.2013 11:51:20
Thms
Hallo,
schonmal vielen Dank für Eure Antworten.
Leider hab ich es immer noch nicht hinbekommen ..
Evtl. zum besseren Verständnis hier mal der gesamte Code. Mein Ziel ist es, dass jeder die Filterfunktion etc. nutzen kann, ohne ein Passwort eingeben zu müssen. Für inhaltliche Änderungen soll es allerdings verpflichtend sein. Wie könnte ich das hinbekommen?
Hier nun der Code:
Sub Schritt_1_Filterergebnisse_in_Ergbnisstabelle_kopieren()
Dim i As Long, j As Long, k As Long
Dim lngLetzte As Long
Dim rngA As Range
Dim wks As Worksheet
Set wks = Sheets("Ergebnisse")
j = 2
With wks
lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:C" & lngLetzte).ClearContents
.Range("A2:C" & lngLetzte).EntireRow.RowHeight = 54
End With
With ActiveSheet
.Unprotect ' HalloWelt
If .AutoFilterMode Then
If .FilterMode Then
For i = 2 To .AutoFilter.Range.Rows.Count
If Rows(i).Hidden = False Then
If .Cells(i, 2).MergeCells = True Then
k = .Cells(i, 2).MergeArea.Row
wks.Cells(j, 1) = .Cells(i, 1)
wks.Cells(j, 2) = .Cells(k, 2)
wks.Cells(j, 3) = .Cells(k, 3)
wks.Cells(j, 4) = .Cells(k, 4)
wks.Cells(j, 5) = .Cells(k, 5)
wks.Cells(j, 6) = .Cells(k, 6)
wks.Cells(j, 7) = .Cells(k, 7)
wks.Cells(j, 8) = .Cells(k, 8)
wks.Cells(j, 9) = .Cells(k, 9)
wks.Cells(j, 10) = .Cells(k, 10)
wks.Cells(j, 11) = .Cells(k, 11)
wks.Cells(j, 12) = .Cells(k, 12)
wks.Cells(j, 12) = .Cells(k, 13)
wks.Cells(j, 12) = .Cells(k, 14)
wks.Cells(j, 12) = .Cells(k, 15)
wks.Cells(j, 12) = .Cells(k, 16)
wks.Cells(j, 12) = .Cells(k, 17)
wks.Rows(j).RowHeight = 300
j = j + 1
Else
wks.Range(wks.Cells(j, 1), wks.Cells(j, 3)) = .Range(.Cells(i, 1), .Cells( _
i, 3)).Value
j = j + 1
End If
End If
Next i
.ShowAllData
End If
End If
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True, Password:="HalloWelt"
End Sub
Beste Grüße
Thomas