Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Spalten sortieren mit Blattschutz
#11
Hallo



da sind offenbar so einige kleine Flüchtigkeitsfehler in diversen Codes!   Gehen wir sie der Reihe nach durch:



Löscht nur eine Zelle statt die ganze Zeile.   Ist laut Makro auch völlig korrekt, beim Code  Selection.Delete!

Code:
Private Sub CommandButton22_Click()
  ActiveSheet.Unprotect Password:="TEST"
  Selection.EntireRow.Delete Shift:=xlUp
  ActiveSheet.Protect Password:="TEST"
End Sub


Die Umschaltung in L1 funktioniert nicht.  Kann sie auch nicht, wenn man im Makro NICHT von 1 auf 2 oder umgekehrt wechselt!

Code:
Sub Spalten_C_F_EIN_AUS()
      Application.ScreenUpdating = False
      ActiveSheet.Unprotect Password:="TEST"
      Select Case ActiveSheet.Range("H1").Value
        Case 1
          Range("J:J,K:K").EntireColumn.Hidden = True
          Range("G:G,H:H,I:I").EntireColumn.Hidden = False
          ActiveSheet.Range("H1") = 2
        Case 2
          Range("G:G,I:I").EntireColumn.Hidden = True
          Range("H:H,J:J,K:K").EntireColumn.Hidden = False
          ActiveSheet.Range("H1") = 1
      End Select
      If [d2].Value = "Free" Then Exit Sub
      ActiveSheet.Protect Password:="TEST"
      Application.ScreenUpdating = True
End Sub
'Zusätzlich Code unter Tabelle1, falls Wert in A4 nicht über die Options-Schaltflächen geändert _
wird


Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Hallo"
  ActiveSheet.Unprotect Password:="TEST"
  If Range("H1") = 3 Then Exit Sub
  Select Case Target.Address
    Case "$D$1"
      Spalten_J_K_EIN_AUS
    Case Else
      'do nothing
       If [d2].Value = "Free" Then Exit Sub
       ActiveSheet.Protect Password:="TEST"
  End Select
End Sub


Auch diese Funktion ist laut Makro völlig korrekt.  Da kann man sich zu Tode ärgern.  Oder man ist einfach Clever!



Zitat:wenn ich die Tabelle manuell entsperre und iregendwohin klicke, sperrt sie sich automatisch wieder


Ich habe mir erlaubt an deiner Beispieldatei ein paar kleine Änderungen vorzunehmen. Die könnten dich verblüffen.

Um die Tabelle entsperrt bearbeiten zu können gibst du in Zelle "D2" den Text "Free" ein, dann  bleibt sie entsperrt.

Den Blattschutz kannst du durch einmal umschalten von L1 Deaktivieren. Bei meinem Code bleibt er auch deaktiviert.


Zum Umschalten von L! habe ich die Zelle von D! nach H1 verlegt. Da liegt sie unter einem Button, nicht zugänglich.
Dafür habe ich den Blattschutz für H1 aufgehoben, sonst kann es sein das die Umschaltung irgendwann versagt!


mfg  Gast 123

Für Heute ist's genug, wenn es noch Probleme gibt, morgen ist auch noch ein Tag ....


Angehängte Dateien
.xlsm   TEST_001 F.xlsm (Größe: 160,9 KB / Downloads: 8)
Antworten Top
#12
Hi Gast 123,

das mit den "Flüchtigkeitsfehlern" ist nett ;)

Tatsache ist.. VBA und ich = unterschiedliche Welten Blush 

Alle Scripte sind zusammengeklaubt und nach besten Wissen und Verständnis reingebastelt... daher auch die Probleme :(

Ich hab das mal getestet... leider gibt es immernoch Probleme...

Einfügen/Löschen von Zeilen

Löschen funktioniert nun.. beim Einfügen fügt er keine kpl. mehr Zeile ein :(

Spalten sichtbar/unsichtbar umschalten

komisch... das hat ja funktioniert, wenn der Blattschutz abgeschaltet ist...

Nach Deiner Anpassung funktioniert es nun aber auch noch nicht... es wird lediglich auf den Blattschutz ("Free") reagiert, aber ees wird nix mehr ein-/ausgeblendet...

Wenn ich das richtig sehe, wird auch nichts in H1 geschrieben 92 (Die Idee das hinter den Button zu packen ist super :) )

Du hast mit dem "Free" eine echt geniale Idee, von der ich nicht mal wußte, dass sowas möglich ist.. 23 ...leider funktioniert das so nicht  Confused

Ich musste erst etwas probieren um zu verstehen, wie Du das meinst... hab's aber dann verstanden... leider sperrt sie sich wieder, wenn ich irgendwohin anders klicke 22 

Aber genau das kann ja passieren, wenn ich etwas "mehr" ändern muss/will.. z.B. eine hinterlegte Formel... oder... ich hab "Free" eingetragen und wollte mir die
ausgeblendeten Spalten anzeigen lassen... schwupps gesperrt  Blush

Ich sehe im Code auch, dass sich wohl eine Message-Box öffnen soll... aber da passiert nix...

Hatte erst gedacht, dass liegt an dieser Zeile:

Zitat:Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Hallo"
  ActiveSheet.Unprotect Password:="TEST"
  If Range("H1") = 3 Then Exit Sub
  Select Case Target.Address
    Case "$D$1"
      Spalten_J_K_EIN_AUS
    Case Else
      'do nothing
      If [d2].Value = "Free" Then Exit Sub
      ActiveSheet.Protect Password:="TEST"
  End Select
End Sub


dass dies ja $H$1 lauten müsste.. aber geht auch nicht  Undecided 

hmm

Ich danke Dir vielmals für Deine Mühe 23
Gruß

ItsME
Antworten Top
#13
Hallöchen,

bisschen was kann man sich auch erschließen Smile Free ist das Stichwort. Wenn Du im Code danach suchst, findest Du es z.B. in dieser Zeile:

If [c2].Value = "Free" Then Exit Sub

Wenn es denn in D2 steht, wäre eine Korrektur nicht schlecht Smile


Die Zeile steht im

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

zu Deutsch so was wie ... AuswahlWechsel ..., also wenn Du in eine andere Zelle klickst, also was Du als Aktion beim Problem beschrieben hast Smile
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#14
Hi schauan (André),

jetzt komm ich schon ins schwimmen 20 

Dies steht im Code:

Zitat:If [d2].Value = "Free" Then Exit Sub
und dort steht auch "Free".. wenn man es reinschreibt ;)


Die Optionsfelder sollten eigentlich eine andere Funktion haben... wenn kein "Free" drin steht...

Vielleicht eine kurze Erklärung am Rande zur gesamten Arbeitsmappe...

Diese ist für eine Kollegin, welche mit Excel arbeiten, aber nichts dran ändern kann... gern aber etwas löscht ohne es zu wollen Sleepy 

Daher soll sie alles können, was sie zum eintragen oder löschen braucht, der Rest soll gesperrt sein.

Andersherum möchte ich natürlich ggf. auch Anpassungen vornehmen können.

Da es am Schluss 150 Tabellenblätter werden, wäre es schwierig, für jeden kleinen Vorgang die Sperre raus zu nehmen... daher war ich von der Free-Idee so begeistert... vllt. geht das auch anders? Keine ahnung :(
Gruß

ItsME
Antworten Top
#15
Hallöchen,

Zitat:leider sperrt sie sich wieder, wenn ich irgendwohin anders klicke

wenn Du nicht willst, dass bei Auswahl einer anderen Zelle das Blatt geschützt wird, muss entweder entsprechend dem Code in C2 Free eingetragen werden oder im Code muss auf D2 verwiesen werden, wo in der Beispieldatei bereits Free steht. Wie auch immer, Deine Entscheidung Smile
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#16
Hallo

wie man sieht mache ich mit [c2] und [d2] auch nach 25 Jahren programmieren immer noch Flüchtigkeitsfehler!  Ich nehme es gelassen ...

Das die Umschaltung bei L1 nicht funktioniert ist auch normal, WENN der Wert in H1 Null ist!  Ausgewertet wurde 1+2, aber keine leere Zelle!
      Select Case ActiveSheet.Range("H1").Value      Bitte hier den Code ändern, dann klappt es auch wenn der Wert mal verloren geht.
        Case 1, ""

Wenn du noch an anderen Stellen im Code das Blatt automtisch sperrst kannst du diesen Befehl VOR ActiveSheet.Protect setzen. 
      If [d2].Value = "Free" Then Exit Sub          Das nennt man sich seinen eigenen Code basteln, darin hast du Übung ...
      ActiveSheet.Protect Password:="TEST"

Mein Fehler mit "neue Zeile einfügen" liegt in diesem Code.  Ich hatte versucht was zu ändern, klappte nicht, und vergessen den alten Code zurückzusetzen!
Code:
Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="TEST"
    Selection.EntireRow.Insert Shift:=xlDown
    ' ACHTUNG: Das With darf nicht 1 drüber, da sich durch das Insert die Selection ändert
    With Selection.EntireRow
        .Offset(-1, 0).Resize(1).Copy
        .PasteSpecial Paste:=xlPasteFormulas
    End With
    ActiveSheet.Protect Password:="TEST"
    Application.ScreenUpdating = True
End Sub

Wenn du ihn wieder im alten Code laufen lässt funktioniert er wieder wie vorher.  Ich hoffe das wir damit so langsam alle Fehler beseitigt haben.
Wenn nicht machen wir solange weiter bis es zu deiner Zufriedenheit klappt.

mfg  Gast 123
Antworten Top
#17
Hi.

sensationell... es funktioniert Alles...

ok, das mit

If [d2].Value = "Free" Then Exit Sub

ist noch nicht so ganz lauffähig, aber tatsächlich nicht schlimm.

Da kann ich mich in Ruhe dran versuchen... weil der Rest funktioniert :)

Eine Frage habe ich aber noch ;)

Ich lassmir ja hiermit eine Box anzeigen, auf der alle Tabellenblätter angezeigt werden.. das funktioniert sowei auch...

Zitat:Private Sub ListBox1_Click()
Sheets(ListBox1.Value).Visible = xlSheetVisible
Sheets(ListBox1.Value).Select
End Sub

Private Sub Userform_Initialize()

Dim objSheet As Object

    With Me
      .StartUpPosition = 0
      .Top = Application.Top + 169
      .Left = Application.Width - (Width + 20)
    End With

    With ListBox1
      .Clear
        For Each objSheet In ThisWorkbook.Sheets
          If objSheet.Visible = xlSheetVisible Or objSheet.Visible = xlSheetHidden Then
              .AddItem objSheet.Name
          End If
        Next
      ListBox1.ListIndex = ActiveSheet.Index - 1
    End With
End Sub

Private Sub UserForm_Activate()
    With Me
        .StartUpPosition = 0
        .Top = Application.Top + 169
        .Left = Application.Width - (Width + 20)
    End With
   
    With ListBox1
      .Clear
        For Each objSheet In ThisWorkbook.Sheets
          If objSheet.Visible = xlSheetVisible Or objSheet.Visible = xlSheetHidden Then
              .AddItem objSheet.Name
          End If
        Next
      ListBox1.ListIndex = ActiveSheet.Index - 1
    End With

End Sub


aber gibt es hier eine Möglichkeit, aus geblendete Sheets nicht anzuzeigen?

Das wäre dann das i-Tüpfelchen :)

Ansonsten

18 23 Thumbsupsmileyanim 98

Für Eure Hilfe...
Gruß

ItsME
Antworten Top
#18
Hallo

leichtes schmunzeln, ich brauchte 3-4 Sekunden, dann stach mir die Lösung in deinem Code direkt ins Auge.  Man sieht es förmlich ...
          If objSheet.Visible = xlSheetVisible Or objSheet.Visible = xlSheetHidden Then

Nimm bitte das Or heraus, dann klappt auch das nur sichtbare Blätter aufgelistet werden.
Freut mich das dieser Thread nach langer Zeit zu einem erfreulichen Abschluss gekommen ist.

mfg Gast 123
Antworten Top
#19
Hi Sir ;)

passt perfekt  19

Vielen Dank... ich versuch jetzt mal das mit dem "Free" in den Tabelle zu basteln ;)

Sollte ich wieder scheitern.. darf ich ich noch einmal melden? Angel 

Gruß & vielen Dank
Gruß

ItsME
Antworten Top
#20
Hallo

sichher, ich bin aber nicht jeden Tag im Forum.  Kann schon mal 2-3 tage dauern ...

mfg Gast 123
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 2 Gast/Gäste